VBA 代码循环遍历单元格范围并为条件格式中具有红色向下箭头的字体着色

Question

我在 A1:B5 范围内有以下数据。

A	B
↓5	↑21
↑35	↓3

规则如下 - 条件格式规则

所以 3 个图标集，当值 >=20 时为绿色向上箭头，当 <20 and >=15 时为黄色箭头，当 <15.

时为红色向下箭头

我想要实现的是检查单元格中是否有红色向下箭头，如果有，则将文本着色为红色（255,0,0）。

我向 ChatGPT 寻求帮助，它吐出了以下代码：

Sub ColorRedArrows()
    Dim ws As Worksheet
    Dim cell As Range

    ' Define the worksheet and range
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your actual sheet name
    Dim rng As Range
    Set rng = ws.Range("A1:B20")

    ' Loop through each cell in the range
    For Each cell In rng
        ' Check if cell has conditional formatting with an icon set and a red down arrow
        On Error Resume Next ' Ignore errors if DisplayFormat is not applicable
        If Not cell.DisplayFormat Is Nothing Then
            ' Check if the cell's displayed icon is a red down arrow
            If cell.DisplayFormat.IconIndex = 1 Then
                ' Change the font color to red
                cell.Font.Color = RGB(255, 0, 0)
            End If
        End If
        On Error GoTo 0 ' Resume normal error handling
    Next cell
End Sub

代码为所有带有数据的单元格着色，而不仅仅是带有红色向下箭头的单元格。

我转向克劳德，他展示了不同的方法。这是代码：

Sub ColorRedArrows()
    Dim ws As Worksheet
    Dim cell As Range
    Dim cf As IconSetCondition
    
    ' Define the worksheet and range
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your actual sheet name
    Dim rng As Range
    Set rng = ws.Range("A1:B20")
    
    ' Loop through each cell in the range
    For Each cell In rng
        ' Check if cell has conditional formatting
        If cell.FormatConditions.Count > 0 Then
            ' Check if the conditional formatting is an icon set
            If cell.FormatConditions(1).Type = xlIconSet Then
                Set cf = cell.FormatConditions(1).IconSet
                ' Check if the icon set has at least 3 icons (to ensure it has a red down arrow)
                If cf.IconSet.ID = xlIconSet3Arrows Then
                    ' Check if the cell's value triggers the red down arrow (lowest threshold)
                    If cell.Value <= cf.IconCriteria(1).Value Then
                        ' Change the font color to red
                        cell.Font.Color = RGB(255, 0, 0)
                    End If
                End If
            End If
        End If
    Next cell
End Sub

但是，代码无法运行，并且我不断收到“编译错误：类型不匹配”错误。我尝试过的法学硕士都没有能够修复这个错误，而且我自己似乎也找不到解决方案，所以任何帮助将不胜感激。

Answer 1

要手动达到所需的结果，非常容易。条件：

=(VALUE-MIN(RNG))/(MAX(RNG)-MIN(RNG))<PERCENTAGE

因此，您只需添加带有公式的格式规则即可：

=(A1-MIN($A$1:$B$5))/(MAX($A$1:$B$5)-MIN($A$1:$B$5))<0.15

通过

vba

以编程方式执行此操作（可能）很棘手，因为：

1. 无法从

   Range

   对象本身检索格式化规则的应用（例如，它不存在于

   Range.DisplayFormat

   中），并且

2. xlIconRedDownArrow

   不一定与任何

   xlIconSet

   的最小阈值相关。例如，你可以做一些像这样奇怪的事情：

下面的代码假设：

• 使用

  xl3Arrows

  。
• 默认使用

  xlIconRedDownArrow

  作为第一个

  IconCriterion.Index

  ：最小阈值。
• 默认使用

  .Type

  ：“百分比”(= 3)。

Sub ColorRedArrows()

    Dim rng As Range
    Dim iconSetCond As IconSetCondition, iconCrit As IconCriterion
    Dim i As Long, j As Long
    
    Dim nextOperator As Long, invOperator As String
    Dim nextValue As Double
    
    Dim firstAddress As String, rngAddress As String
    Dim myFormula As String

    Set rng = Range("A1:B5")

    With rng
        For i = 1 To .FormatConditions.Count
            If rng.FormatConditions(i).Type = 6 Then 'xlIconSet
                Set iconSetCond = rng.FormatConditions(i)
                For j = 1 To iconSetCond.IconCriteria.Count
                    Set iconCrit = iconSetCond.IconCriteria(j)
                    If iconCrit.Icon = 3 Then 'xlIconRedDownArrow
                        If iconCrit.Index = 1 Then 'assuming default
                            'next operator -> inverse operator / 'next value
                            nextOperator = iconSetCond.IconCriteria(j + 1).Operator
                            invOperator = IIf(nextOperator = 7, "<", "<=")
                            nextValue = iconSetCond.IconCriteria(j + 1).Value * 0.01
                        End If
                        j = iconSetCond.IconCriteria.Count 'exit loop
                    End If
                Next j
                i = .FormatConditions.Count 'exit loop
            End If
        Next i

        firstAddress = rng.Cells(1, 1).Address(False, False)
        rngAddress = rng.Address(True, True)
        
        'build formula
        myFormula = "=(" & firstAddress & "-MIN(" & rngAddress & "))/(MAX(" & rngAddress _
        & ")-MIN(" & rngAddress & "))" & invOperator & nextValue

        'add new rule
        .FormatConditions.Add Type:=xlExpression, Formula1:=myFormula
        .FormatConditions(.FormatConditions.Count).Font.Color = RGB(255, 0, 0)

    End With

End Sub

结果位于

MAX=100

和

MAX=60

: