[英]Count all Excel cells with a certain color
我正在尝试计算 Excel 中具有特定颜色的所有单元格。我已经编写了下面的代码,但它不计算条件格式突出显示的单元格。 你有什么想法如何做到这一点? 提前致谢!
Function CountByColor(rg As Range, RefColorCell As Range) As Long
'Counts cells colored manually, whether hidden by a filter or not. _
Does not count cells colored by conditional formatting! _
Install function in a regular module sheet, just like a recorded macro.
Dim cel As Range, rgg As Range
Dim i As Long, RefColor As Long
RefColor = RefColorCell.Interior.Color
Application.Volatile
Set rgg = Intersect(rg, rg.Worksheet.UsedRange) 'In case you passed an entire column
For Each cel In rgg.Cells
If cel.Interior.Color = RefColor Then i = i + 1
Next
CountByColor = i
End Function
正如评论中所述,作为 CUSTOM function 这并不容易实现,因为属性.cel.DisplayFormat.Interior.Color
不会返回 function 的值,但是当用作宏时它会返回一个值。
要获得所需内容,您将需要我从Chip Pearson 的传奇网站中提取的以下冗长的自定义函数集。 虽然它太多了,但我进行了测试,当我将它嵌入到您原来的 function CountByColor
中时它确实有效。
示例文件在这里(不适用于 Web 版本的 Excel)
Function CountByColor(rg As Range, RefColorCell As Range) As Long
Dim cel As Range, rgg As Range, i As Long, RefColor As Long
RefColor = RefColorCell.Interior.Color
Application.Volatile
Set rgg = Intersect(rg, rg.Worksheet.UsedRange)
For Each cel In rgg.Cells
If ColorOfCF(cel) = RefColor Then i = i + 1
Next
CountByColor = i
End Function
Private Function ActiveCondition(Rng As Range) As Long
Dim Ndx As Long, FC As FormatCondition
Dim Temp As Variant, Temp2 As Variant
If Rng.FormatConditions.Count = 0 Then
ActiveCondition = 0
Else
For Ndx = 1 To Rng.FormatConditions.Count
Set FC = Rng.FormatConditions(Ndx)
Select Case FC.Type
Case xlCellValue
Select Case FC.Operator
Case xlBetween
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= CDbl(FC.Formula1) And _
CDbl(Rng.Value) <= CDbl(FC.Formula2) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Temp And _
Rng.Value <= Temp2 Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlGreater
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value > Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Temp = Rng.Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlGreaterEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlLess
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) < CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value < Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlLessEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value <= Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlNotEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <> CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Temp <> Rng.Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlNotBetween
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If Not (CDbl(Rng.Value) <= CDbl(FC.Formula1)) And _
(CDbl(Rng.Value) >= CDbl(FC.Formula2)) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Not Rng.Value <= Temp And _
Rng.Value >= Temp2 Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case Else
Debug.Print "UNKNOWN OPERATOR"
End Select
Case xlExpression
If Application.Evaluate(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Case Else
Debug.Print "UNKNOWN TYPE"
End Select
Next Ndx
End If
ActiveCondition = 0
End Function
Private Function ColorOfCF(Rng As Range, Optional OfText As Boolean = False) As Long
Dim AC As Long
AC = ActiveCondition(Rng)
If AC = 0 Then
If OfText = True Then
ColorOfCF = Rng.Font.Color
Else
ColorOfCF = Rng.Interior.Color
End If
Else
If OfText = True Then
ColorOfCF = Rng.FormatConditions(AC).Font.Color
Else
ColorOfCF = Rng.FormatConditions(AC).Interior.Color
End If
End If
End Function
'''''''''''''''''''''''''''''''''''''''
Private Function GetStrippedValue(CF As String) As String
Dim Temp As String
If InStr(1, CF, "=", vbTextCompare) Then
Temp = Mid(CF, 3, Len(CF) - 3)
If Left(Temp, 1) = "=" Then
Temp = Mid(Temp, 2)
End If
Else
Temp = CF
End If
GetStrippedValue = Temp
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.