如何用VBA编写循环实现对应单元格求和并写入目标区域

现有代码问题分析 #

• WriteToCell：循环遍历区域时始终只给固定单元格D18赋值，未根据当前循环的单元格位置匹配对应源区域的单元格，无法实现批量对应求和。
• CombineRanges：仅合并并选中两个源区域，未执行任何求和计算，不符合需求。

循环实现方案（匹配你的需求） #

以下代码通过双重循环逐个匹配对应单元格，完成求和写入：

Sub RangeSum()
    Dim srcRng1 As Range, srcRng2 As Range, destRng As Range
    Dim i As Long, j As Long
    
    ' 绑定三个目标区域，根据实际工作表修改Sheet名称
    Set srcRng1 = Sheet1.Range("C23:ABR34")
    Set srcRng2 = Sheet1.Range("C45:ABR56")
    Set destRng = Sheet1.Range("C67:ABR78")
    
    ' 校验区域尺寸一致性，避免运行错误
    If srcRng1.Rows.Count <> srcRng2.Rows.Count Or srcRng1.Columns.Count <> srcRng2.Column.Count _
        Or srcRng1.Rows.Count <> destRng.Rows.Count Or srcRng1.Columns.Count <> destRng.Columns.Count Then
        MsgBox "三个区域的行、列数必须完全一致！"
        Exit Sub
    End If
    
    ' 逐行逐列遍历，对应单元格求和写入
    For i = 1 To srcRng1.Rows.Count
        For j = 1 To srcRng1.Columns.Count
            destRng.Cells(i, j).Value = srcRng1.Cells(i, j).Value + srcRng2.Cells(i, j).Value
        Next j
    Next i
End Sub

高效优化方案（大区域推荐） #

如果处理的区域较大（比如你用到的ABR列包含大量列），用数组操作会比逐个单元格读写快很多，代码如下：

Sub RangeSumWithArray()
    Dim srcArr1 As Variant, srcArr2 As Variant, destArr As Variant
    Dim i As Long, j As Long
    
    ' 将单元格区域读取到内存数组
    srcArr1 = Sheet1.Range("C23:ABR34").Value
    srcArr2 = Sheet1.Range("C45:ABR56").Value
    
    ' 初始化目标数组，尺寸与源数组一致
    ReDim destArr(1 To UBound(srcArr1, 1), 1 To UBound(srcArr1, 2))
    
    ' 数组内循环完成求和
    For i = 1 To UBound(srcArr1, 1)
        For j = 1 To UBound(srcArr1, 2)
            destArr(i, j) = srcArr1(i, j) + srcArr2(i, j)
        Next j
    Next i
    
    ' 将结果数组一次性写入目标区域
    Sheet1.Range("C67:ABR78").Value = destArr
End Sub

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