用于测试单元格是否在 Excel 中有条件地格式化的 VBA 函数

Question

我编写了下面的函数来测试单元格是否根据单元格填充激活了条件格式。

Function cfTest(inputCell)

    If inputCell.DisplayFormat.Interior.Color <> 16777215 Then
        cfTest = True
    Else
       cfTest = False
    End If
End Function

但它不起作用。话说，这个方法可以。

Sub myCFtest()
Dim R As Integer
R = 2
Do
    If Range("I" & R).DisplayFormat.Interior.Color <> 16777215 Then
        Range("K" & R).Value = True
    Else
        Range("K" & R).Value = False
    End If

    R = R + 1

Loop Until R = 20
End Sub

谁能向我解释为什么该功能不起作用？

干杯。

编辑：更新了函数，但不适用于条件格式

Function cfTest(inputCell)
    If inputCell.Interior.ColorIndex <> -4142 Then
        cfTest = True
    Else
       cfTest = False
    End If
End Function

Answer 1

这是一个工作演示，如果需要的结果。 E 列查看 D 列，如果按单元格填充颜色有条件地格式化，则显示值 TRUE。即单击名称“Bob”，并通过下面的代码有条件地格式化突出显示单元格

=IF(AND(CELL("row")=ROW(D1),CELL("col")=COLUMN(D1)),TRUE)

点击另一个名字，也会出现同样的结果。

但是，当我在另一个单元格上单击名称时，我选择的姓氏仍然突出显示，给人一种按钮仍然按下的印象。

后面的VBA代码如下。

这位于 Sheet1 代码中：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 4 And Target.Row <= Application.WorksheetFunction.CountA(Range("D:D")) Then
    Range("D:D").Calculate
    Call cfTest

End If

End Sub

这就是方法本身：

Sub cfTest()

Range("E:E").ClearContents

If ActiveCell.DisplayFormat.Interior.color <> 16777215 Then
    ActiveCell.Offset(0, 1) = True
End If

End Sub

我最终基于此示例构建的应用程序还有更多功能，但回到发布的问题，cfTest() 方法允许我测试一个单元格是否根据单元格填充有条件地格式化。

Answer 2

这里有两个实现数学条件的相关函数。这比 Chip Pearson 版本稍微简单一些，也不太完整，但我认为这应该涵盖大多数情况，并且扩展起来应该不会太困难。

Function isConditionallyFormatted(rng As Range) As Boolean

    Dim f As FormatCondition

    On Error Resume Next
    isConditionallyFormatted = False
    For Each f In rng.FormatConditions

        isConditionallyFormatted = checkFormula(rng.Value, f.operator, f.Formula1)
        isConditionallyFormatted = checkFormula(rng.Value, f.operator, f.Formula2)

        Next

End Function

Function checkFormula(rng As Variant, operator As Variant, condition As Variant)

    On Error GoTo errHandler:

    Dim formula As String
    condition = Right(condition, Len(condition) - 1)
    Select Case operator

            Case xlEqual: formula = rng & "=" & condition
            Case xlGreater: formula = rng & ">" & condition
            Case xlGreaterEqual: formula = rng & ">=" & condition
            Case xlLess: formula = rng & "<" & condition
            Case xlLessEqual: formula = rng & "<=" & condition
            Case xlExpression: formula = condition

            End Select

    checkFormula = Evaluate(formula)
Exit Function
errHandler:
    Debug.Print Err.Number & " : " & Err.Description
End Function

这适用于一些常见的运算符，但还有另外两个运算符（xlBetween 和 xlNotBetween），还有其他类型的条件也必须被捕获，其中一些的逻辑会更多比这复杂。然而，其中一些（如数据栏）固有地传达存在条件，因此不需要处理。

这里是完整文档的链接：

http://msdn.microsoft.com/en-us/ff835850(v=office.15)

Answer 3

我不确定这是为什么，但也许会有所帮助。当颜色基于条件格式时，VB 似乎不允许访问单元格颜色。

例如..

'cell A1 colored yellow through conditional formatting
MsgBox Range("A1").Interior.ColorIndex
'returns the incorrect result of -4142 regardless of cell color

'cell B1 colored yellow via the fill option on the ribbon
MsgBox Range("B1").Interior.ColorIndex
'returns the correct result of 6

话虽如此，您是否有理由不能只测试单元格的任何有效格式规则。这将消除对 UDF 的需求。

=IF(A1<50,False,True)

Answer 4

我会事先检查你的条件是使用这个的颜色索引：

Function cfTest_color_chk(inputCell As Range)
  cfTest_color_chk = inputCell.Interior.ColorIndex
End Function

然后你的功能

Function cfTest(inputCell As Range)
  If inputCell.Interior.ColorIndex <> -4142 Then
      cfTest = True
  Else
     cfTest = False
  End If
End Function

另一个让事情变得坚如磐​​石的解决方案是将这两个函数结合起来，以便 cfTest 将 cfTest_color_chk 作为参数，而 cfTest_color_chk 将返回要匹配的颜色值...

希望对你有帮助

帕斯卡