VBA范围嵌套循环批量跨工作表赋值实现方法问询

核心思路 #

通过存储「源区域-目标区域」对应关系的数组，结合双层循环（循环目标工作表 + 循环对应关系）实现批量赋值，既避免重复代码，又保留.Value方法对合并单元格的适配性。.Value会自动读取合并区域的顶层值，赋值时也会对应到目标合并区域，完全符合需求。

实现代码示例 #

Sub BatchCopyMergedData()
    ' 定义源工作表
    Dim sourceWs As Worksheet
    Set sourceWs = ThisWorkbook.Worksheets("Remplissage")
    
    ' 定义源-目标区域对应关系数组（每一行存一组对应地址，共120组）
    Dim mappings As Variant
    mappings = Array( _
        Array("A1", "B2"), _
        Array("C3:C6", "D4:D7"), _
        Array("E2", "F5"), _
        ' 在此处补充剩余的117组对应关系...
    )
    
    ' 循环处理30个目标工作表（假设表名格式为PTS-1至PTS-30）
    Dim wsIndex As Integer
    For wsIndex = 1 To 30
        Dim targetWs As Worksheet
        ' 容错处理：避免工作表不存在导致报错
        On Error Resume Next
        Set targetWs = ThisWorkbook.Worksheets("PTS-" & wsIndex)
        On Error GoTo 0
        
        If Not targetWs Is Nothing Then
            ' 循环执行每组区域的赋值
            Dim mapIndex As Integer
            For mapIndex = LBound(mappings) To UBound(mappings)
                Dim sourceAddr As String, targetAddr As String
                sourceAddr = mappings(mapIndex)(0)
                targetAddr = mappings(mapIndex)(1)
                
                ' 用.Value批量赋值，自动适配合并单元格
                targetWs.Range(targetAddr).Value = sourceWs.Range(sourceAddr).Value
            Next mapIndex
        End If
    Next wsIndex
End Sub

关键细节说明 #

1. 数组存储对应关系：
   不用逐个编写120行赋值语句，而是把所有源、目标区域地址存入数组，通过循环遍历完成赋值，代码更简洁易维护。如果对应关系有变动，只需修改数组内容即可。

2. .Value适配合并单元格：
   读取合并区域时，.Value返回区域左上角单元格的值；赋值时，值会写入目标区域的左上角单元格，若目标是合并区域，整个合并范围都会显示该值，完全满足合并单元格的赋值需求。

3. 扩展到30个目标工作表：
   外层循环遍历工作表序号，自动匹配PTS-1至PTS-30的工作表名，无需重复编写针对每个工作表的代码。

进阶优化（可选） #

如果120组对应关系需要频繁修改，可在Excel中新建一个隐藏工作表（如命名为Mapping），用A列存源区域地址、B列存目标区域地址，然后从工作表读取对应关系到数组，无需修改代码：

' 从隐藏工作表读取对应关系
Dim mappingWs As Worksheet
Set mappingWs = ThisWorkbook.Worksheets("Mapping")
mappings = mappingWs.Range("A1:B120").Value

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