Excel VBA循环中如何重置数组Vr以仅存单行列数据 解决转置限制问题

现有代码问题说明 #

你当前的代码没有实现每次For循环仅保留当前行数据的逻辑，存在以下核心问题：

• 计数变量n没有在每轮外层i循环（逐行处理循环）启动时重置，n会延续上一轮行处理的数值持续累加，导致数组长度不断增大，始终保留之前所有行的历史数据
• Dim Vr()写在j循环内部无实际作用：VBA同一过程内的变量声明只会执行一次，不会因为放在循环结构里就每次循环重新声明数组
• 隐性逻辑错误：你用With wsUploadDPK绑定目标表后，Cells前面没有加.，实际会写入活动工作表而非指定的wsUploadDPK表

修正方案 #

按以下逻辑调整即可保证每次循环仅存储当前行的有效数据：

1. 每轮外层i循环启动时，先重置计数n=0，同时清空Vr数组
2. 修正目标表单元格的引用错误
3. 增加数组非空判断，避免无有效数据时转置报错

修正后完整代码如下：

Dim Vr() As Variant
Dim n As Long
For i = 2 To r
    ' 每轮处理新行前重置计数和数组
    n = 0
    Erase Vr
    For j = 3 To c
        If vDB(i, j) <> "" And vDB(1, j) <> "name" And vDB(1, j) <> "COMMENTS" And vDB(1, j) <> "" Then
            n = n + 1
            ReDim Preserve Vr(1 To 5, 1 To n)
            For k = 1 To 2
                Vr(k, n) = vDB(i, k)
            Next k
            Vr(5, n) = vDB(i, j)
            Vr(3, n) = vDB(1, j)
            Vr(4, n) = wsDesign.Cells(37, j + 1).Interior.Color
        End If
    Next j
    ' 仅当有有效数据时执行粘贴
    If n > 0 Then
        With wsUploadDPK
            ' 注意Cells前加.绑定到当前With的工作表，这里写的是追加写入逻辑，如果需要覆盖写入可自行调整起始位置
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(n, 5) = WorksheetFunction.Transpose(Vr)
        End With
    End If
Next i
End With

补充说明 #

如果遇到行数超过65536的转置限制（Excel旧版WorksheetFunction.Transpose函数的固有约束），可以直接调整数组维度为行优先，存储时直接按Vr(n, 1)的顺序赋值，最后不用转置直接写入表格，性能更好也不会触发限制。

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