编写按颜色统计单元格且不重复统计合并单元格的Excel宏

嗨，我完全懂你的困扰——明明是一个合并单元格区域，结果宏把每个格子都算一遍，统计出来的数字完全不对对吧？别担心，我给你写了一个专门解决这个问题的VBA宏，能精准统计每个颜色对应的合并区域数量，而不是单个单元格数。

核心思路 #

要避免重复统计合并单元格，关键是只对每个合并区域的左上角单元格进行计数——因为Excel里的合并区域，只有左上角的单元格是这个区域的“代表”，我们只需要判断当前单元格是不是它所在合并区域的第一个单元格，是就统计，不是就跳过。

完整宏代码 #

Sub CountCellsByColorWithoutMergedDuplicates()
    Dim targetRange As Range
    Dim cell As Range
    Dim colorCount As Object
    Dim mergeTopLeft As Range
    
    ' 让用户选择要统计的目标区域（可自行修改为固定范围，比如Range("A1:E10")）
    Set targetRange = Application.InputBox("请选择要统计的单元格区域", Type:=8)
    Set colorCount = CreateObject("Scripting.Dictionary")
    
    ' 遍历目标区域内的每一个单元格
    For Each cell In targetRange
        ' 获取当前单元格所在合并区域的左上角单元格
        Set mergeTopLeft = cell.MergeArea.Cells(1, 1)
        ' 只处理合并区域的第一个单元格，避免重复计数
        If cell.Address = mergeTopLeft.Address Then
            ' 获取单元格填充颜色的索引值
            Dim colorIndex As Integer
            colorIndex = cell.Interior.ColorIndex
            
            ' 更新颜色计数：已存在则累加，不存在则初始化
            If colorCount.Exists(colorIndex) Then
                colorCount(colorIndex) = colorCount(colorIndex) + 1
            Else
                colorCount(colorIndex) = 1
            End If
        End If
    Next cell
    
    ' 拼接统计结果并弹出提示框
    Dim key As Variant
    Dim resultMsg As String
    resultMsg = "颜色统计结果（不重复统计合并单元格）：" & vbCrLf & vbCrLf
    For Each key In colorCount.Keys
        resultMsg = resultMsg & "颜色索引 " & key & ": " & colorCount(key) & " 个" & vbCrLf
    Next key
    
    MsgBox resultMsg, vbInformation, "统计完成"
End Sub

使用步骤 #

• 打开你的Excel文件，按下Alt + F11打开VBA编辑器
• 在左侧工程窗口右键点击你的工作簿，选择「插入」→「模块」
• 将上面的代码粘贴到新建的模块里
• 返回Excel界面，按下Alt + F8，选择CountCellsByColorWithoutMergedDuplicates这个宏，点击「执行」
• 按照提示选择要统计的单元格区域，就能得到正确的结果啦！

补充说明 #

• 代码里用颜色索引来区分颜色，如果你想显示颜色名称，可以额外加一段映射颜色索引到名称的逻辑，不过日常用索引足够区分不同颜色了
• 如果需要把统计结果输出到工作表的指定单元格（而不是消息框），可以把最后的MsgBox部分改成写入单元格的代码，比如Range("G1").Value = "颜色索引 " & key & ": " & colorCount(key)

举你的例子来说，运行这个宏后，就会准确返回2个黄色区域、3个绿色区域，完全符合你的需求~

备注：内容来源于stack exchange，提问作者Jessie Shepard