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

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

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

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 

但是，我发现的是条件格式倾斜颜色索引。 任何人都可以帮助我修复上述function，检查条件格式化的单元格的颜色代码？

Answer 1

这不是一个微不足道的任务。

原来的解决scheme是张贴在这里（可能现在脱机）： http : //www.excelfox.com/forum/showthread.php/338-Get-Displayed-Cell-Color- (whether-from-Conditional-Formatting- or-不）

 ' 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