Excel VBA实现10个工作表3列单元格颜色汇总至1列的方法

核心思路 #

遍历每个人员的独立工作表，依次读取Jan/Feb/March三列的单元格填充颜色，按「人员名称→Jan列所有行→Feb列所有行→March列所有行」的顺序，将颜色复制到汇总表的单列中，同时兼顾操作简化性。

完整VBA代码 #

Sub 汇总人员日程颜色()
    Dim 汇总表 As Worksheet
    Dim 人员表 As Worksheet
    Dim 目标行 As Integer
    Dim 源行 As Integer
    Dim 源列 As Integer
    
    ' 指定汇总表，请确保表名与实际一致
    Set 汇总表 = ThisWorkbook.Worksheets("汇总表")
    ' 清空汇总表A列原有内容和格式（按需保留）
    汇总表.Range("A:A").Clear
    
    目标行 = 1 ' 汇总表数据起始行
    
    ' 遍历所有工作表，跳过汇总表
    For Each 人员表 In ThisWorkbook.Worksheets
        If 人员表.Name <> "汇总表" Then
            ' 写入人员名称作为分隔标识（可选，方便区分）
            汇总表.Cells(目标行, 1).Value = 人员表.Name
            汇总表.Cells(目标行, 1).Font.Bold = True
            目标行 = 目标行 + 1
            
            ' 遍历Jan(Feb/March对应A/B/C列，即列索引1/2/3)
            For 源列 = 1 To 3
                源行 = 1
                ' 循环读取当前列的有效行（非空或有颜色的单元格）
                Do While 人员表.Cells(源行, 源列).Value <> "" Or 人员表.Cells(源行, 源列).Interior.ColorIndex <> xlColorIndexNone
                    ' 复制单元格填充颜色到汇总表
                    汇总表.Cells(目标行, 1).Interior.Color = 人员表.Cells(源行, 源列).Interior.Color
                    ' 如需同步单元格内容，取消下方注释
                    ' 汇总表.Cells(目标行, 1).Value = 人员表.Cells(源行, 源列).Value
                    
                    目标行 = 目标行 + 1
                    源行 = 源行 + 1
                    ' 设置最大行数限制，防止无限循环（可根据需求调整）
                    If 源行 > 100 Then Exit Do
                Loop
            Next 源列
        End If
    Next 人员表
End Sub

代码关键说明 #

1. 工作表遍历：自动识别所有非汇总表的工作表，无需手动指定10个人员表的名称，后续新增人员表也能自动适配。
2. 颜色复制逻辑：逐行读取三列的单元格颜色，不管单元格是否有内容，只要设置了填充颜色就会被复制到汇总表。
3. 防无限循环：设置了最大行数限制（100行），可根据实际日程行数调整数值。
4. 可选标识：自动写入人员名称并加粗，方便在汇总表中快速区分不同人员的日程段。

简化人员操作的建议 #

• 固定列布局：要求所有人员工作表统一用A列=Jan、B列=Feb、C列=March，避免列位置混乱导致汇总失败。
• 保护工作表：给人员工作表设置格式保护，仅允许修改单元格填充颜色（设置路径：审阅→保护工作表→勾选"设置单元格格式"），防止误改列结构。
• 一键执行：把汇总宏添加到Excel快速访问工具栏，人员或管理员点击即可完成汇总，无需接触VBA代码。

内容的提问来源于stack exchange，提问作者JD Keay