如何用VBA统计指定单元格区域内各填充颜色的出现次数？

原代码的问题 #

• 最终返回字符串时，深红色对应的变量错误，写成了R（红色的统计变量），应该用Re
• 直接硬编码RGB值可能和Excel中实际填充颜色不匹配（比如主题色的RGB会随主题变化），如果是自定义颜色，建议先提取目标单元格的颜色值再对比

修正后的代码 #

Function lbrHrsTot(Rng As Range) As String
    Dim R As Long, G As Long, B As Long, Re As Long, Y As Long, S As Long
    Dim Cell As Range
    
    For Each Cell In Rng
        Select Case Cell.Interior.Color
            Case RGB(255, 0, 0) '红色
                R = R + 1
            Case RGB(0, 176, 80) '绿色
                G = G + 1
            Case RGB(0, 176, 240) '蓝色
                B = B + 1
            Case RGB(166, 166, 166) '银色
                S = S + 1
            Case RGB(255, 192, 0) '黄色
                Y = Y + 1
            Case RGB(192, 0, 0) '深红色
                Re = Re + 1
        End Select
    Next Cell
    
    '优化返回格式，用换行分隔更清晰
    lbrHrsTot = "红色: " & R & vbCrLf & _
                "绿色: " & G & vbCrLf & _
                "蓝色: " & B & vbCrLf & _
                "银色: " & S & vbCrLf & _
                "黄色: " & Y & vbCrLf & _
                "深红色: " & Re
End Function

额外提示 #

如果发现颜色还是匹配不上，可以先运行下面的小宏获取目标单元格的RGB值，替换到代码中：

Sub GetCellRGB()
    Dim c As Range
    Set c = Selection
    MsgBox "RGB(" & c.Interior.ColorMod(2) & ", " & c.Interior.ColorMod(1) & ", " & c.Interior.ColorMod(0) & ")"
End Sub

内容的提问来源于stack exchange，提问作者Mecca Miles