Excel VBA数组写入单元格区域仅首个元素重复填充异常排查

你遇到的单列区域全部重复填充数组第一个元素的问题，核心是VBA数组与工作表区域的维度匹配规则导致的，叠加代码里的一个笔误共同触发异常：

• VBA中从单元格区域读取到的数组固定为二维结构，维度顺序为(行号, 列号)；但你定义的计算结果数组arr6是一维数组。VBA默认将一维数组识别为横向排布的单行数组，当你把一维数组直接赋值给纵向的单列多行区域时，不会抛出下标错误，只会取数组的第一个元素填充整个目标区域，这就是异常的直接诱因。
• 代码存在变量赋值笔误：获取arr5列维度上界时，你错误地将值赋给了列下界变量lb2，即lb2 = UBound(arr5, 2)，这行本应给ub2赋值，属于潜在逻辑隐患。
• 循环下标未绑定数组上下界：你读取arr5时从工作表第2行开始加载，虽然此时数组行下标默认从1开始，你写的For rows = 1 To lr(ws2, 1) - 1碰巧能运行，但如果后续改了读取区域的起始行，很容易触发下标越界错误。

优先推荐直接定义和目标区域维度完全匹配的二维结果数组，不需要依赖转置函数，无长度限制，兼容性最好：

With ws2
    Dim arr5() As Variant
    Dim lastRow As Long
    ' 提前计算最后一行，避免重复调用自定义函数
    lastRow = lr(ws2, 1)
    Set clls = .Range(.Cells(2, 8), .Cells(lastRow, 9))
    arr5 = clls.Value2
End With

' 正确获取数组两个维度的上下界，修正原有笔误
lb1 = LBound(arr5, 1)
ub1 = UBound(arr5, 1)
lb2 = LBound(arr5, 2)
ub2 = UBound(arr5, 2)

' 定义和单列目标区域匹配的二维数组：行维度和源数据一致，列维度固定为1（对应J列1列）
Dim arr6() As Variant
ReDim arr6(lb1 To ub1, 1 To 1)

With ws2
    ' 循环范围绑定数组上下界，避免硬编码下标
    For r = lb1 To ub1
        debe = arr5(r, 1)
        habr = arr5(r, 2)
        arr6(r, 1) = debe - habr
    Next r
    Set clls = .Range(.Cells(2, 10), .Cells(lastRow, 10))
    clls.Value = arr6
End With

如果你希望保留一维数组的写法，写入时需要调用工作表转置函数，将横向的一维数组转换为纵向结构再赋值，注意该方法在数组元素总数超过65536时会失效：

' 其余逻辑不变，写入区域时增加转置
clls.Value = WorksheetFunction.Transpose(arr6)

提示：VBA中只要是给多单元格区域批量赋值数组，优先保证数组的维度、行数、列数和目标区域完全一致，可以避免绝大多数批量写入异常。

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