我编写了下面的函数来测试单元格是否根据单元格填充激活了条件格式。
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
答案 0 :(得分:4)
如果需要的话,这是一个有效的演示。 E列查看D列,如果有条件地按单元格填充颜色格式化,则显示值TRUE。即点击名称&#39; Bob&#39;,并通过下面的代码有条件地格式化高亮显示单元格
=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()方法允许我测试一个单元格是否根据单元格填充进行了条件格式化。
答案 1 :(得分:1)
我不确定为什么会这样,但也许它会有所帮助。当该颜色基于条件格式时,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)
答案 2 :(得分:1)
以下是实现数学条件的两个相关函数。这比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),还有其他类型的条件也必须被捕获,其中一些的逻辑会更多一些比这更复杂。然而,它们中的一些(如数据库)本身就表明存在条件,因此不需要进行任何处理。
以下是完整文档的链接:
答案 3 :(得分:0)
我会事先检查您使用此条件的颜色索引:
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将返回颜色的值以匹配......
希望这有帮助
帕斯卡