excel 在条件格式中插入单元格位置

rjee0c15  于 2023-05-30  发布在  其他
关注(0)|答案(3)|浏览(201)

所以我有一个这样的代码:

Sub ApplyIconSets()

Dim rng As Range
Dim iset As IconSetCondition

Set rng = Application.InputBox("Select a Range", "Obtained Range Object", Type:=8)
rng.Name = "selected"

LastRow = Range("selected").Rows.Count
LastColumn = Range("selected").Columns.Count

With Range("selected")
    For i = 2 To LastColumn
        For r = 1 To LastRow
            Set iset = .Cells(r, i).FormatConditions.AddIconSetCondition
            With iset
                .IconSet = ActiveWorkbook.IconSets(xl3Arrows)
                .ReverseOrder = False
                .ShowIconOnly = False
            End With
            With iset.IconCriteria(2)
                .Type = xlConditionValueFormula
                .Operator = xlGreaterEqual
                .Value = Range("selected").Cells(r, i).Offset(, -1)
            End With
            With iset.IconCriteria(3)
                .Type = xlConditionValueFormula
                .Operator = xlGreaterEqual
                .Value = Range("selected").Cells(r, i).Offset(, -1)
            End With
        Next r
    Next i
End With

结束子
基本上,这段代码根据单元格前面的单元格值将IconSet条件格式应用于单元格。代码运行得很好,但有一点我想改进它。
当我检查应用的条件时,代码输入前面单元格的绝对值,而不是单元格的位置。Like This
但是,我希望代码能够输入单元格位置,这样当我更改数据时,它仍然可以工作,而不是让我重新运行代码。Like this
我试过改变

.Value = Range("selected").Cells(r,i).Offset(,-1).Address

但它返回一个字符串,因此条件不起作用。
有人知道解决办法吗?
先谢谢你了。

nnvyjq4y

nnvyjq4y1#

我不确定你的条件格式逻辑是否正确。您的代码永远不会显示琥珀色箭头,因为IconCriteria(3)将首先计算。由于IconCriteria(2)具有相同的属性值,因此永远不会满足。如果您希望绿色箭头显示大于测试单元格值的数字,而琥珀色箭头显示等于该值的数字,则需要编写以下代码。
我还想知道ForEach循环是否会更简单,特别是因为它会传递单元格区域本身,所以您可以从中派生工作簿和工作表对象。这将避免不合格范围的潜在问题。您只需要添加一个If语句,以确保不会尝试偏移超过第1列。
总而言之,下面的代码可能会满足您的目的。顺便说一句,我建议在你的模块顶部添加Option Explicit,并处理用户在输入框上点击Cancel的情况:

Option Explicit

Sub ApplyIconSets()

    Dim sel As Range, cell As Range

    ' Acquire the target range and handle a cancelled input box.
    On Error GoTo Canx
    Set sel = Application.InputBox("Select a Range", "Obtained Range Object", Type:=8)

    ' Iterate cell by cell to add the condition.
    On Error GoTo EH
    For Each cell In sel.Cells

        'Ignore the cell if it is in column 1.
        If cell.Column > 1 Then

            With cell.FormatConditions
                'Delete existing conditions.
                .Delete
                'Add a new condition.
                With .AddIconSetCondition
                    .IconSet = cell.Worksheet.Parent.IconSets(xl3Arrows)
                    'Set the amber criterion.
                    'Note: we have to use '>=' but anything '>' will be caught
                    'in the green operator, so only '=' will meet this criterion.
                    With .IconCriteria(2)
                        .Type = xlConditionValueFormula
                        .Operator = xlGreaterEqual
                        .Value = "=" & cell.Worksheet.Name & "!" & cell.Offset(, -1).Address
                    End With
                    'Set the green criterion.
                    'Note: we have to use just '>' because this is evaluated first
                    'and '>=' would result in amber never capturing a value.
                    With .IconCriteria(3)
                        .Type = xlConditionValueFormula
                        .Operator = xlGreater
                        .Value = "=" & cell.Worksheet.Name & "!" & cell.Offset(, -1).Address
                    End With
                End With
            End With
        End If
    Next

    Exit Sub

Canx:
    Debug.Print "User cancelled."
    Exit Sub
EH:
    Debug.Print Err.Number; Err.Description
End Sub
uidvcgyl

uidvcgyl2#

这段代码做你想要的。

Sub ApplyIconSets()

    Dim LastRow As Long, LastColumn As Long
    Dim Rng As Range
    Dim iSet As IconSetCondition
    Dim i As Integer, R As Integer

    Set Rng = Application.InputBox("Select a Range", "Obtained Range Object", Type:=8)
    Rng.Name = "selected"

    LastRow = Range("selected").Rows.Count
    LastColumn = Range("selected").Columns.Count

    With Range("selected")
        For i = 1 To LastColumn
            For R = 1 To LastRow
                Set iSet = .Cells(R, i).FormatConditions.AddIconSetCondition
                With iSet
                    .IconSet = ActiveWorkbook.IconSets(xl3Arrows)
                    .ReverseOrder = False
                    .ShowIconOnly = False
                End With
                With iSet.IconCriteria(2)
                    .Type = xlConditionValueFormula
                    .Operator = xlGreaterEqual
                    .Value = "=" & Range("selected").Cells(R, i).Offset(, -1).Address
                End With
                With iSet.IconCriteria(3)
                    .Type = xlConditionValueFormula
                    .Operator = xlGreaterEqual
                    .Value = "=" & Range("selected").Cells(R, i).Offset(, -1).Address
                End With
            Next R
        Next i
    End With
End Sub

我不想再花时间做进一步的实验:我认为可以一次性为整个范围设置条件,导致Excel设置相对格式而不是绝对格式。你可以试试速度会有差别。您可能还想添加一些代码,在应用新的CF之前删除现有的CF。CF很容易超载,然后会减慢你的工作表。

kognpnkq

kognpnkq3#

请尝试在每个段中定义值作为对单元格的引用,如下所示:

With iset.IconCriteria(3)
   .Type = xlConditionValueFormula
   .Operator = xlGreaterEqual
   .Value = "=Sheet1!$B$1"
End With

你必须用变量替换字符串,像这样:

.Value = "=Sheet1!" & Range("selected").Cells(r, i).Offset(, -1).Address

相关问题