VBA遍历数组报错求助：调用Initial(i)时出现错误

核心错误原因 #

你调用Initial(i)报错的根本问题是循环变量i的取值和数组索引不匹配：

• 循环里i按1,4,7,...（Step 3）递增，但你的Initial数组索引是1,2,3,...，当i=4时，Initial(4)根本没赋值（你只手动给前3个索引赋值了），直接访问会触发下标越界错误。
• 另外你统计的NumRows是用户人数，循环写成To NumRows*3逻辑错误——你要处理NumRows个用户，每个用户占3行，应该循环NumRows次，再计算每行的位置。

其他问题点 #

1. 硬编码数组大小(1 To 18)，用户人数变化会直接报错；
2. 手动给数组赋值效率极低，无法适配更多数据；
3. 依赖Activate切换工作表，容易因当前工作表变化导致逻辑混乱；
4. 未声明NumRows变量，违反VBA规范（建议开启Option Explicit强制变量声明）。

修正后的完整代码 #

Sub LoopTEST2()
    ' 声明变量
    Dim wsNames As Worksheet, wsLoopTest As Worksheet
    Dim Initial() As String, Names() As String
    Dim NumRows As Long, i As Long, writeRow As Long
    
    ' 绑定工作表对象，避免Activate
    Set wsNames = ThisWorkbook.Worksheets("Names")
    Set wsLoopTest = ThisWorkbook.Worksheets("LoopTest")
    
    ' 统计有效用户行数（从A2开始向下到非空行）
    NumRows = wsNames.Range("A2", wsNames.Range("A2").End(xlDown)).Rows.Count
    
    ' 动态定义数组大小
    ReDim Initial(1 To NumRows) As String
    ReDim Names(1 To NumRows) As String
    
    ' 批量读取数据到数组
    For i = 1 To NumRows
        Initial(i) = wsNames.Range("A" & i + 1).Value ' A2对应i=1，A3对应i=2，以此类推
        Names(i) = wsNames.Range("B" & i + 1).Value
    Next i
    
    ' 写入LoopTest工作表
    writeRow = 1 ' 起始行
    For i = 1 To NumRows
        wsLoopTest.Cells(writeRow, 1).Value = Initial(i)
        wsLoopTest.Cells(writeRow + 1, 1).Value = "Sex:"
        wsLoopTest.Cells(writeRow + 2, 1).Value = "Age:"
        writeRow = writeRow + 3 ' 每次跳3行处理下一个用户
    Next i
End Sub

关键改进说明 #

• 数组索引匹配：用独立的循环变量i遍历数组（1到用户人数），用writeRow控制写入的行号，每次加3，彻底解决索引不匹配问题；
• 动态数组：用ReDim根据实际用户数定义数组大小，避免硬编码的局限性；
• 直接引用工作表：通过Set绑定工作表对象，不再依赖Activate，代码更稳定；
• 批量读取：用循环自动读取所有用户数据，不用手动逐个赋值；
• 变量规范：声明所有变量，避免隐式类型转换问题。

内容的提问来源于stack exchange，提问作者One foot in the Grave