Excel VBA遍历二维数组：转置数据循环仅读第一行问题排查

需求与现状 #

• 目标：将Sheet1中的单行源数据，转置为符合系统导入要求的多行多列格式，输出到Sheet2
• 当前问题：仅能处理第一行源数据，添加循环后仍重复输出第一行内容，无法遍历后续行
• 已完成：第一行数据的格式调整符合要求，采用数组方式处理

当前VBA代码 #

Sub Test()

Dim arr() As Variant
Dim i As Long, j As Long
Dim lastRow As Long
Dim lastColumn As Long
Dim c As Long
Dim r As Long

arr = Sheet1.Range("A2").CurrentRegion

lastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1
lastColumn = Sheet2.Cells(lastRow, Columns.Count).End(xlToLeft).Column

For i = LBound(arr) To UBound(arr)

     Sheet2.Cells(lastRow, lastColumn).Value = "CADPSIHD"
     c = lastColumn + 1
     r = 2

        Sheet2.Cells(lastRow, c).Value = arr(r, 1)
        Sheet2.Cells(lastRow, c + 1).Value = arr(r, 2)
        Sheet2.Cells(lastRow, c + 2).Value = "OTH"
        Sheet2.Cells(lastRow, c + 3).Value = "CHARGE"
        Sheet2.Cells(lastRow, c + 4).Value = "STUDY"

           Call Headers
           Call Component
           Call Cost

      c = lastColumn + 3
        Dim r2 As Long
        r2 = lastRow + 1
        Sheet2.Cells(r2, c).Value = arr(r, 3)
        Sheet2.Cells(r2 + 1, c).Value = arr(r, 4)
        Sheet2.Cells(r2 + 2, c).Value = arr(r, 5)
        Sheet2.Cells(r2 + 3, c).Value = arr(r, 6)
    Next i
End Sub

问题分析 #

1. 循环变量未被利用：循环中用r=2固定调用数组第二行数据，循环变量i完全未参与行遍历，导致始终读取第一行源数据
2. 输出位置未动态更新：lastRow和lastColumn仅在循环外初始化一次，每次循环都往同一位置写入，覆盖之前内容且无法推进到新行
3. 子过程调用无上下文：Headers/Component/Cost三个子过程未传递当前行参数，若它们负责生成对应行内容，会重复执行相同逻辑

修正后的代码示例 #

Sub TransposeData()
    Dim arr As Variant
    Dim i As Long, outputRow As Long
    Dim fixedContents As Variant
    
    ' 读取Sheet1中A2开始的所有有效数据
    arr = Sheet1.Range("A2").CurrentRegion.Value
    ' 初始化Sheet2的起始输出行（自动判断是否有表头）
    outputRow = IIf(Sheet2.Cells(1, 1).Value = "", 1, Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1)
    ' 定义固定填充的内容，简化代码维护
    fixedContents = Array("CADPSIHD", "OTH", "CHARGE", "STUDY")
    
    ' 遍历每一行源数据
    For i = LBound(arr, 1) To UBound(arr, 1)
        ' 写入第一行的固定内容与源数据前两列
        Sheet2.Cells(outputRow, 1).Value = fixedContents(0)
        Sheet2.Cells(outputRow, 2).Value = arr(i, 1)
        Sheet2.Cells(outputRow, 3).Value = arr(i, 2)
        Sheet2.Cells(outputRow, 4).Value = fixedContents(1)
        Sheet2.Cells(outputRow, 5).Value = fixedContents(2)
        Sheet2.Cells(outputRow, 6).Value = fixedContents(3)
        
        ' 调用子过程时传递当前输出行作为参数（需对应修改子过程接收参数）
        ' Call Headers(outputRow)
        ' Call Component(outputRow)
        ' Call Cost(outputRow)
        
        ' 将源数据第3-6列转置到下方4行的对应列（可根据实际格式调整列号）
        Sheet2.Cells(outputRow + 1, 4).Value = arr(i, 3)
        Sheet2.Cells(outputRow + 2, 4).Value = arr(i, 4)
        Sheet2.Cells(outputRow + 3, 4).Value = arr(i, 5)
        Sheet2.Cells(outputRow + 4, 4).Value = arr(i, 6)
        
        ' 更新输出行，跳到下一组数据的起始位置（每组占5行，可按需调整）
        outputRow = outputRow + 5
    Next i
End Sub

修正说明 #

• 用循环变量i遍历数组的每一行，实现所有源数据的遍历
• 动态更新outputRow，确保每组数据写入Sheet2的新位置
• 将固定内容存入数组，提升代码可维护性
• 注释了子过程的参数传递建议，避免重复生成相同内容

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