如何在Excel VBA中实现数据刷新时保留单元格填充色与字体色

从数据库刷新Excel数据时，新增行会导致单元格填充色和字体色错位。需要在刷新宏中加入以下操作步骤：

• 存储当前单元格的填充色与字体色信息
• 清除所有颜色
• 执行数据刷新
• 将颜色重新应用到对应单元格

现有一段仅用于恢复手动备注列文本内容的VBA代码，可修改该代码来处理颜色信息，核心思路是通过唯一标识（如工单编号）匹配行，同步保存与还原颜色属性：

原代码（仅处理文本） #

plannerData = plannerSheet.Range("A3:BO" & CStr(lastRowPlanner))
    historyData = historySheet.Range("A2:BO" & CStr(lastRowHistory))
    lastRowPlannerData = UBound(plannerData, 1)
    lastRowHistoryData = UBound(historyData, 1)

    For plannerRow = 1 To lastRowPlannerData
        plannerValue = plannerData(plannerRow, 4) ' 获取工单编号
        
        For historyRow = 1 To lastRowHistoryData
            historyValue = historyData(historyRow, 4) ' 匹配历史数据中的工单编号
            
            If plannerValue = historyValue Then 
                For i = LBound(columnsToCopy) To UBound(columnsToCopy)
                    plannerData(plannerRow, columnsToCopy(i)) = historyData(historyRow, columnsToCopy(i))
                Next i
                
                Exit For ' 找到匹配项后退出循环，处理下一行
                
            End If
            
        Next historyRow
    
    Next plannerRow
    
    ' 将恢复后的文本写回工作表
    plannerSheet.Range("A3:BO" & CStr(lastRowPlanner)).Value = plannerData

修改后的代码（支持颜色存储与还原） #

Sub RefreshDataAndRestoreColors()
    Dim plannerSheet As Worksheet, historySheet As Worksheet
    Set plannerSheet = ThisWorkbook.Sheets("Planner") ' 替换为你的工作表名
    Set historySheet = ThisWorkbook.Sheets("History") ' 替换为你的历史表名
    
    Dim lastRowPlanner As Long, lastRowHistory As Long
    lastRowPlanner = plannerSheet.Cells(plannerSheet.Rows.Count, "A").End(xlUp).Row
    lastRowHistory = historySheet.Cells(historySheet.Rows.Count, "A").End(xlUp).Row
    
    ' 1. 存储当前单元格的填充色与字体色信息
    Dim plannerFillColors As Variant, plannerFontColors As Variant
    ' A3:BO共67列，根据实际列数调整
    ReDim plannerFillColors(1 To lastRowPlanner - 2, 1 To 67)
    ReDim plannerFontColors(1 To lastRowPlanner - 2, 1 To 67)
    
    Dim r As Long, c As Long
    For r = 3 To lastRowPlanner
        For c = 1 To 67
            plannerFillColors(r - 2, c) = plannerSheet.Cells(r, c).Interior.Color
            plannerFontColors(r - 2, c) = plannerSheet.Cells(r, c).Font.Color
        Next c
    Next r
    
    ' 同时存储原有的文本备注数据（保留原逻辑）
    Dim plannerData As Variant, historyData As Variant
    plannerData = plannerSheet.Range("A3:BO" & lastRowPlanner).Value
    historyData = historySheet.Range("A2:BO" & lastRowHistory).Value
    
    ' 2. 清除所有颜色
    plannerSheet.Range("A3:BO" & lastRowPlanner).Interior.ColorIndex = xlColorIndexNone
    plannerSheet.Range("A3:BO" & lastRowPlanner).Font.ColorIndex = xlColorIndexAutomatic
    
    ' 3. 刷新数据库数据（替换为你的刷新代码）
    ' Call YourRefreshMacroName
    
    ' 刷新后获取新的行号
    Dim newLastRowPlanner As Long
    newLastRowPlanner = plannerSheet.Cells(plannerSheet.Rows.Count, "A").End(xlUp).Row
    Dim newPlannerData As Variant
    newPlannerData = plannerSheet.Range("A3:BO" & newLastRowPlanner).Value
    
    ' 4. 恢复文本备注与颜色
    Dim columnsToCopy As Variant
    columnsToCopy = Array(...) ' 替换为你的备注列索引
    
    ' 先恢复文本备注（原逻辑）
    For plannerRow = 1 To UBound(newPlannerData, 1)
        Dim plannerWO As String
        plannerWO = newPlannerData(plannerRow, 4)
        
        For historyRow = 1 To UBound(historyData, 1)
            Dim historyWO As String
            historyWO = historyData(historyRow, 4)
            
            If plannerWO = historyWO Then
                For i = LBound(columnsToCopy) To UBound(columnsToCopy)
                    plannerSheet.Cells(plannerRow + 2, columnsToCopy(i)).Value = historyData(historyRow, columnsToCopy(i))
                Next i
                Exit For
            End If
        Next historyRow
    Next plannerRow
    
    ' 再恢复颜色
    For plannerRow = 1 To UBound(newPlannerData, 1)
        Dim currentWO As String
        currentWO = newPlannerData(plannerRow, 4)
        
        For originalRow = 1 To UBound(plannerFillColors, 1)
            Dim originalWO As String
            originalWO = plannerData(originalRow, 4) ' 从存储的原数据中获取工单编号
            
            If currentWO = originalWO Then
                For c = 1 To 67
                    plannerSheet.Cells(plannerRow + 2, c).Interior.Color = plannerFillColors(originalRow, c)
                    plannerSheet.Cells(plannerRow + 2, c).Font.Color = plannerFontColors(originalRow, c)
                Next c
                Exit For
            End If
        Next originalRow
    Next plannerRow
End Sub

关键说明 #

• 用二维数组存储原单元格的填充色和字体色，确保每个单元格的颜色信息被精准记录
• 通过工单编号（第4列）作为匹配依据，即使新增行，也能将颜色对应到正确的工单行
• 若你的数据区域列数不是67（A到BO），需调整数组的列数参数
• 替换代码中的工作表名、刷新宏名称和备注列索引为实际值

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