如何将工作表白色单元格复制到另一工作簿对应位置并补0？

针对你的需求，以下是修改后的VBA代码，可实现跨工作簿复制白色单元格值、为空白色单元格填充"0"的功能：

Sub CopyWhiteCellsAndFillZero()
    Dim sourceWB As Workbook, targetWB As Workbook
    Dim sourceWS As Worksheet, targetWS As Worksheet
    Dim cell As Range
    Dim usedRange As Range
    
    ' 选择源工作簿和目标工作簿
    Set sourceWB = Workbooks.Open(Application.GetOpenFilename("Excel文件 (*.xlsx;*.xls), *.xlsx;*.xls", Title:="选择源工作簿"))
    Set targetWB = Workbooks.Open(Application.GetOpenFilename("Excel文件 (*.xlsx;*.xls), *.xlsx;*.xls", Title:="选择目标工作簿"))
    
    ' 遍历源工作簿的每个工作表（与目标工作簿结构一致，按顺序匹配）
    For Each sourceWS In sourceWB.Worksheets
        Set targetWS = targetWB.Worksheets(sourceWS.Index) ' 按索引匹配工作表，确保结构一致
        
        ' 获取当前工作表的已使用区域，避免遍历整个工作表
        Set usedRange = sourceWS.UsedRange
        
        ' 遍历已使用区域内的每个单元格
        For Each cell In usedRange
            ' 判断单元格是否为白色背景
            If cell.Interior.Color = RGB(255, 255, 255) Then
                ' 如果源单元格有值，复制到目标对应位置
                If cell.Value <> "" Then
                    targetWS.Range(cell.Address).Value = cell.Value
                Else
                    ' 如果源单元格是空的白色单元格，目标对应位置填充"0"
                    targetWS.Range(cell.Address).Value = "0"
                End If
            End If
        Next cell
    Next sourceWS
    
    ' 保存并关闭工作簿（可选，根据需要调整）
    targetWB.Save
    sourceWB.Close SaveChanges:=False
    targetWB.Close SaveChanges:=False
    
    MsgBox "处理完成！"
End Sub

代码关键说明： #

• 工作簿选择：通过GetOpenFilename让用户手动选择源和目标工作簿，避免硬编码文件名，适配不同场景。
• 工作表匹配：利用工作表索引sourceWS.Index匹配目标工作簿的对应工作表，确保结构一致的工作表一一对应。
• 已使用区域遍历：仅遍历工作表的UsedRange，大幅提升运行效率，避免遍历无数据的单元格。
• 白色单元格判断：通过RGB(255,255,255)识别白色背景单元格，符合你的需求。
• 值复制与填充：区分源单元格是否有值，有值则复制到目标对应位置，空值则为目标单元格填充"0"。

使用注意事项： #

1. 运行代码前，确保源和目标工作簿的工作表结构完全一致（工作表数量、顺序、单元格布局相同）。
2. 如果工作簿已打开，可直接替换Workbooks.Open部分为Set sourceWB = Workbooks("源工作簿名称.xlsx")，无需重新打开。
3. 代码末尾的保存关闭逻辑可根据实际需求调整，若需要保留工作簿打开状态，可删除targetWB.Close和sourceWB.Close相关行。

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