Excel VBA中的颜色不同但颜色索引相同

时间:2012-06-29 10:16:50

标签: vba excel-2007

我使用下面的代码在Excel中获取单元格的颜色索引。

Original Link

Function ConditionalColor(rg As Range, FormatType As String) As Long
  'Returns the color index (either font or interior) of the first cell in range rg. If no _
 conditional format conditions apply, Then returns the regular color of the cell. _
    FormatType Is either "Font" Or "Interior"
    Dim cel As Range
    Dim tmp As Variant
    Dim boo As Boolean
    Dim frmla As String, frmlaR1C1 As String, frmlaA1 As String
    Dim i As Long

     'Application.Volatile    'This statement required if Conditional Formatting for rg is determined by the _
    value of other cells

    Set cel = rg.Cells(1, 1)
    Select Case Left(LCase(FormatType), 1)
    Case "f" 'Font color
        ConditionalColor = cel.Font.ColorIndex
    Case Else 'Interior or highlight color
        ConditionalColor = cel.Interior.ColorIndex
    End Select

    If cel.FormatConditions.Count > 0 Then
         'On Error Resume Next
        With cel.FormatConditions
            For i = 1 To .Count 'Loop through the three possible format conditions for each cell
                frmla = .Item(i).Formula1
                If Left(frmla, 1) = "=" Then 'If "Formula Is", then evaluate if it is True
                     'Conditional Formatting is interpreted relative to the active cell. _
                    This cause the wrong results If the formula isn 't restated relative to the cell containing the _
                    Conditional Formatting--hence the workaround using ConvertFormula twice In a row. _
                    If the Function were Not called using a worksheet formula, you could just activate the cell instead.
                    frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell)
                    frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel)
                    boo = Application.Evaluate(frmlaA1)
                Else 'If "Value Is", then identify the type of comparison operator and build comparison formula
                    Select Case .Item(i).Operator
                    Case xlEqual ' = x
                        frmla = cel & "=" & .Item(i).Formula1
                    Case xlNotEqual ' <> x
                        frmla = cel & "<>" & .Item(i).Formula1
                    Case xlBetween 'x <= cel <= y
                        frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
                    Case xlNotBetween 'x > cel or cel > y
                        frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
                    Case xlLess ' < x
                        frmla = cel & "<" & .Item(i).Formula1
                    Case xlLessEqual ' <= x
                        frmla = cel & "<=" & .Item(i).Formula1
                    Case xlGreater ' > x
                        frmla = cel & ">" & .Item(i).Formula1
                    Case xlGreaterEqual ' >= x
                        frmla = cel & ">=" & .Item(i).Formula1
                    End Select
                    boo = Application.Evaluate(frmla) 'Evaluate the "Value Is" comparison formula
                End If

                If boo Then 'If this Format Condition is satisfied
                    On Error Resume Next
                    Select Case Left(LCase(FormatType), 1)
                    Case "f" 'Font color
                        tmp = .Item(i).Font.ColorIndex
                    Case Else 'Interior or highlight color
                        tmp = .Item(i).Interior.ColorIndex
                    End Select
                    If Err = 0 Then ConditionalColor = tmp
                    Err.Clear
                    On Error GoTo 0
                    Exit For 'Since Format Condition is satisfied, exit the inner loop
                End If
            Next i
        End With
    End If

End Function

但是,如下图所示,2种不同颜色的细胞给出完全相同的颜色指数:

enter image description here

如何解决此错误?

我附上了测试文件here。请检查此错误。

2 个答案:

答案 0 :(得分:3)

编辑:我之前的回答并没有解决您的问题,但我认为这可能仍然与提出同样问题的人有关。

您遇到的问题源于使用Colorindex属性而不是像Color这样更具体的属性。

有关两者之间的详细说明,请参阅此地址: http://msdn.microsoft.com/en-us/library/cc296089(v=office.12).aspx

基本上,只有57种可能的颜色索引值,但可用的颜色要多得多。颜色索引是指给定调色板中的索引。你碰巧偶然发现了两种具有相同索引的颜色。要使程序按预期运行,您应该将colorindex引用更新为颜色。如果不进行更改,您将继续产生令人困惑的结果。


上一个答案: 如果您使用条件格式来推断应该应用其值的单元格,那么当UDF检查以确定条件格式是否为真时,它通常会推迟到当前单元格。

例如,如果您的条件格式设置公式类似于:

= MOD(ROW(),2)= 1

每次代码点击:

frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell)
frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel)                      
boo = Application.Evaluate(frmlaA1) 

它将根据当前活动单元格而不是应用条件格式的单元格进行评估。

我做了一些实验,但是根据您需要使用代码的频率,我认为最好的结果可能是增强公式。 这不会解决所有问题,但您可以尝试在第一个ConvertFormula调用之前插入以下内容:

frmla = Replace(frmla, "()", "(" & cel.Address & ")")

使用Row()或Column()解决了这个问题。

如果这不能完全解决您的问题,我们需要查看条件格式公式。

答案 1 :(得分:2)

我认为混淆的可能原因是条件格式。 两个单元格的原始ColorIndex或Color是相同的。但条件格式“覆盖”原始颜色。然后,如果您尝试从单元格中获取ColorIndex或Color属性,则结果不是您看到的结果,而是原始/底层结果。

顺便说一句,如果您想要获得的是单元格的ColorIndex,您可以使用类似此代码的内容来测试我在这里描述的是否是您的情况。

MsgBox ActiveCell.Interior.ColorIndex

MsgBox ActiveCell.Interior.Color

或者将它写在右边的下一个单元格中:

ActiveCell.Offset(0, 1).Value = ActiveCell.Interior.ColorIndex