檢查有條件格式化單元格的顏色索引

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