Question

所以我有这样的代码：

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

但是它返回一个字符串，因此该条件不起作用。

有人知道解决方案吗？

先谢谢了。

Answer 1

此代码可以满足您的要求。

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很容易过载，然后会使您的图纸变慢。

Answer 2

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

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

您必须将字符串替换为类似这样的变量：

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

如果有帮助，请标记此答案。

Answer 3

我不确定您是否正确设置了条件格式逻辑。您的代码将永远不会显示琥珀色箭头，因为IconCriteria(3)将首先求值。由于IconCriteria(2)具有相同的属性值，因此将永远无法满足。如果您希望绿色箭头显示的数字大于测试的单元格值，而琥珀色箭头显示的数字等于该值，那么您需要编写以下代码。

我还想知道ForEach循环是否会更简单，尤其是因为它会传递单元格区域本身，因此您可以从中派生工作簿和工作表对象。这样可以避免出现不合格范围的潜在问题。您只需要添加一个If语句以确保您没有尝试抵消第1列。

总而言之，下面的代码可能会满足您的目的。顺便说一句，我建议在模块顶部添加Option Explicit并处理用户在输入框上单击“取消”的情况：

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

以条件格式插入单元格位置

3 个答案: