Excel：如何基于颜色唯一ID从参考工作簿提取单元格填充色？

核心思路 #

• 先将参考工作簿中的颜色ID与对应填充色的RGB值存入字典，实现快速匹配（适配1000种颜色的规模）
• 遍历目标工作簿的25个工作表，根据单元格内的颜色ID从字典中调取RGB值，直接填充单元格

实用VBA代码 #

Sub 批量提取填充色()
    Dim refWB As Workbook
    Dim targetWB As Workbook
    Dim colorDict As Object
    Dim refWS As Worksheet
    Dim targetWS As Worksheet
    Dim refRow As Long
    Dim targetRow As Long
    Dim colorID As String
    Dim rgbVals As Variant
    
    ' 初始化字典存储颜色ID与RGB映射
    Set colorDict = CreateObject("Scripting.Dictionary")
    
    ' 打开参考工作簿（替换为你的实际文件路径）
    Set refWB = Workbooks.Open("C:\你的参考工作簿路径.xlsx")
    
    ' 假设参考表中颜色ID在A列，带填充色的单元格在B列（按需调整）
    Set refWS = refWB.Worksheets("颜色参考表")
    refRow = 2 ' 跳过表头，从第2行开始读取
    
    ' 加载颜色映射到字典
    Do While refWS.Cells(refRow, 1).Value <> ""
        colorID = CStr(refWS.Cells(refRow, 1).Value)
        ' 获取填充色的RGB分量
        rgbVals = Array(refWS.Cells(refRow, 2).Interior.ColorMod(1), _
                      refWS.Cells(refRow, 2).Interior.ColorMod(2), _
                      refWS.Cells(refRow, 2).Interior.ColorMod(3))
        If Not colorDict.Exists(colorID) Then
            colorDict.Add colorID, rgbVals
        End If
        refRow = refRow + 1
    Loop
    
    ' 目标工作簿设为当前活动工作簿（或指定路径）
    Set targetWB = ThisWorkbook
    
    ' 遍历目标工作簿的所有工作表（若需指定25个，可修改为按名称循环）
    For Each targetWS In targetWB.Worksheets
        ' 假设目标表中颜色ID在A列，需填充颜色的单元格在B列（按需调整）
        targetRow = 2 ' 跳过表头
        Do While targetWS.Cells(targetRow, 1).Value <> ""
            colorID = CStr(targetWS.Cells(targetRow, 1).Value)
            If colorDict.Exists(colorID) Then
                rgbVals = colorDict(colorID)
                ' 应用填充色
                targetWS.Cells(targetRow, 2).Interior.Color = RGB(rgbVals(0), rgbVals(1), rgbVals(2))
            End If
            targetRow = targetRow + 1
        Loop
    Next targetWS
    
    ' 关闭参考工作簿，无需保存
    refWB.Close SaveChanges:=False
    
    ' 释放对象
    Set colorDict = Nothing
    Set refWS = Nothing
    Set targetWS = Nothing
    Set refWB = Nothing
    Set targetWB = Nothing
    
    MsgBox "颜色填充完成！"
End Sub

使用说明 #

• 替换代码中C:\你的参考工作簿路径.xlsx为实际参考文件路径
• 根据你的表格结构，调整参考表和目标表中颜色ID列、填充列的位置（代码中默认A列存ID，B列存颜色/需填充）
• 若只需处理指定25个工作表，可将遍历所有工作表的代码替换为指定名称循环，示例：

  Dim wsNames As Variant
  wsNames = Array("表1", "表2", ..., "表25") ' 填入你的25个工作表名称
  For Each wsName In wsNames
      Set targetWS = targetWB.Worksheets(wsName)
      ' 后续填充逻辑不变
  Next wsName
  

• 字典查询的时间复杂度为O(1)，1000种颜色×25个工作表的规模能高效完成处理

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