技术求助：如何通过宏按颜色对带色数字列进行分组？

嗨，我来帮你搞定这个按颜色分组数字的需求！下面是一套亲测好用的VBA宏方案，你可以直接套用：

第一步：打开VBA编辑器 #

• 打开你的Excel文件，按下 Alt + F11 快速打开VBA编辑器
• 在左侧的「工程资源管理器」里，右键点击你的目标工作簿，选择「插入」→「模块」，新建一个空白模块

第二步：粘贴宏代码 #

把下面的代码复制粘贴到新建的模块里：

Sub 按颜色分组数字()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim colorDict As Object
    Dim key As Variant
    Dim targetRow As Long
    
    ' 指定要处理的工作表，可改成你的表名，比如 Set ws = ThisWorkbook.Worksheets("数据页")
    Set ws = ActiveSheet
    ' 创建字典来存储不同颜色对应的数字组
    Set colorDict = CreateObject("Scripting.Dictionary")
    
    ' 获取数据列的最后一行（默认处理A列，可按需修改）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历所有数据单元格，按颜色分类
    For Each cell In ws.Range("A2:A" & lastRow) ' 假设A1是表头，从A2开始遍历
        If cell.Value <> "" Then ' 跳过空单元格
            ' 用字体颜色的数值作为字典的唯一标识
            Dim colorKey As String
            colorKey = cell.Font.Color & ""
            
            If Not colorDict.Exists(colorKey) Then
                ' 遇到新颜色时，创建一个集合来存对应数字
                Set colorDict(colorKey) = CreateObject("System.Collections.ArrayList")
            End If
            ' 将当前单元格的数字加入对应颜色的集合
            colorDict(colorKey).Add cell.Value
        End If
    Next cell
    
    ' 将分组好的数据写入C列开始的区域（可修改目标列）
    targetRow = 2 ' 从C2开始写入，建议手动给C1加个表头比如"按颜色分组结果"
    For Each key In colorDict.Keys
        ' 先写入颜色组的标识，同时设置和原数据一样的字体颜色
        ws.Cells(targetRow, "C").Value = "颜色组：RGB(" & RGB( _
            (key Mod 256), _
            ((key \ 256) Mod 256), _
            (key \ 65536) _
        ) & ")"
        ws.Cells(targetRow, "C").Font.Color = CLng(key)
        targetRow = targetRow + 1
        
        ' 写入该颜色对应的所有数字
        For Each item In colorDict(key)
            ws.Cells(targetRow, "C").Value = item
            targetRow = targetRow + 1
        Next item
        ' 空一行分隔不同颜色组，看起来更清晰
        targetRow = targetRow + 1
    Next key
    
    MsgBox "按颜色分组完成！结果已写入C列开始的区域。", vbInformation
End Sub

第三步：根据你的数据调整代码 #

• 如果你的数据不在A列：把代码里的 "A" 改成对应列标（比如 "B"）
• 如果没有表头：把 ws.Range("A2:A" & lastRow) 改成 ws.Range("A1:A" & lastRow)
• 如果想把结果写入其他列：把代码里的 "C" 改成目标列标（比如 "D"）
• 如果是按单元格填充颜色分组：把所有 cell.Font.Color 替换成 cell.Interior.Color

第四步：运行宏 #

• 回到Excel界面，按下 Alt + F8，在弹出的宏列表里选择「按颜色分组数字」，点击「执行」就搞定啦！

小提示 #

• 记得启用宏：如果Excel弹出安全提示，选择「启用内容」才能正常运行宏
• 如果需要保留原数据的格式（比如数字格式），可以把写入数值的语句 ws.Cells(targetRow, "C").Value = item 改成 cell.Copy ws.Cells(targetRow, "C")（需要调整遍历逻辑，或者单独处理格式）

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