检查条件格式单元格的颜色索引

Question

我正在尝试计算有条件着色的单元格（以及满足的任何其他条件）。

检查颜色索引的代码如下：

Function CheckColor(rng As Range)
    Dim arr()
    'ReDim arr(1 To rng.Count, 1 To 1) ' or use this instead of arr = rng.Value2
    arr = rng.Value2   ' arr Type in the Locals window shows as Variant(1 To 11, 1 To 1)
    For i = 1 To rng.Cells.Count
        arr(i, 1) = rng.Cells(i, 1).Interior.ColorIndex = 15
    Next i
    CheckColor = arr
End Function

但是，我发现条件格式会扭曲颜色索引。谁能帮我修复上述功能以检查条件格式单元格的颜色代码？

Answer 1

这不是一项简单的任务。

原解决方案贴在这里（现在可能离线）：http://www.excelfox.com/forum/showthread.php/338-Get-Displayed-Cell-Color-(whether-from-Conditional-Formatting-or-not)

' Arguments
' ----------------
' Cell - Required Range, not a String value, for a **single** cell
'
' CellInterior - Optional Boolean (Default = True)
'                True makes function return cell's Interior Color or ColorIndex based on
'                the ReturnColorIndex argument False makes function return Font's Color or
'                ColorIndex based on the ReturnColorIndex argument
'
' ReturnColorIndex - Optional Boolean (Default = True)
'                    True makes function return the ColorIndex for the cell property determined
'                    by the CellInterior argument False make function return the Color for the
'                    cell property determined by the CellInterior argument
'
Function DisplayedColor(Cell As Range, Optional CellInterior As Boolean = True, _
                        Optional ReturnColorIndex As Long = True) As Long
  Dim X As Long, Test As Boolean, CurrentCell As String
  If Cell.Count > 1 Then Err.Raise vbObjectError - 999, , "Only single cell references allowed for 1st argument."
  CurrentCell = ActiveCell.Address
  For X = 1 To Cell.FormatConditions.Count
    With Cell.FormatConditions(X)
      If .Type = xlCellValue Then
        Select Case .Operator
          Case xlBetween:      Test = Cell.Value >= Evaluate(.Formula1) And Cell.Value <= Evaluate(.Formula2)
          Case xlNotBetween:   Test = Cell.Value <= Evaluate(.Formula1) Or Cell.Value >= Evaluate(.Formula2)
          Case xlEqual:        Test = Evaluate(.Formula1) = Cell.Value
          Case xlNotEqual:     Test = Evaluate(.Formula1) <> Cell.Value
          Case xlGreater:      Test = Cell.Value > Evaluate(.Formula1)
          Case xlLess:         Test = Cell.Value < Evaluate(.Formula1)
          Case xlGreaterEqual: Test = Cell.Value >= Evaluate(.Formula1)
          Case xlLessEqual:    Test = Cell.Value <= Evaluate(.Formula1)
        End Select
      ElseIf .Type = xlExpression Then
        Application.ScreenUpdating = False
        Cell.Select
        Test = Evaluate(.Formula1)
        Range(CurrentCell).Select
        Application.ScreenUpdating = True
      End If
      If Test Then
        If CellInterior Then
          DisplayedColor = IIf(ReturnColorIndex, .Interior.ColorIndex, .Interior.Color)
        Else
          DisplayedColor = IIf(ReturnColorIndex, .Font.ColorIndex, .Font.Color)
        End If
        Exit Function
      End If
    End With
  Next
  If CellInterior Then
    DisplayedColor = IIf(ReturnColorIndex, Cell.Interior.ColorIndex, Cell.Interior.Color)
  Else
    DisplayedColor = IIf(ReturnColorIndex, Cell.Font.ColorIndex, Cell.Font.Color)
  End If
End Function