VBA执行Redim Preserve调整数组时报Subscript out of range错误

核心错误原因 #

• VBA语法限制：ReDim Preserve仅支持修改多维数组的最后一维长度，你定义的listArray(行索引, 列索引)第一维为行、第二维为列，直接修改第一维长度必然触发下标越界
• 逻辑错误：当前代码无论行是否符合筛选条件，每次循环都会扩容数组，会生成大量无效空行；且符合条件的行赋值后没有递增行索引ri
• 变量未重置：内层循环累加的列索引变量c没有在外层循环时重置，第二次循环开始会读取表格不存在的列，也会触发越界

最优解决思路 #

先统计符合筛选条件的总行数，一次性定义数组的大小，不需要频繁执行ReDim Preserve，性能更稳定，也避免了数组转置的额外开销。

修正后完整代码 #

Option Explicit

'This code initializes the frmEntry form and sets the list box control
' to list the active escorts (escort records that have blank values
' in the 'End' field of the visitor log (VLog tabl on Visitor Log worksheet).

Private Sub UserForm_Initialize()

Dim wksVisitorLog As Worksheet
Dim wbkVMS As Workbook
Dim objVisitorEscortList As ListObject
Dim listCounter As Long
Dim matchRowCount As Long
Dim listArray()
Dim ri As Long
Dim ci As Long
Dim c As Long

Set wbkVMS = ThisWorkbook
Set wksVisitorLog = wbkVMS.Worksheets("Visitor Log")
Set objVisitorEscortList = wksVisitorLog.ListObjects("tblVisitorEscortLog")

' 先统计符合条件的行数
matchRowCount = 0
For listCounter = 1 To objVisitorEscortList.ListRows.Count
    If objVisitorEscortList.ListRows(listCounter).Range.Cells(1, 14) = "" Then
        matchRowCount = matchRowCount + 1
    End If
Next listCounter

' 无符合条件数据直接返回
If matchRowCount = 0 Then
    MsgBox "当前没有处于活跃状态的陪同记录", vbOKOnly
    Exit Sub
End If

' 一次性定义数组大小，无需后续扩容
ReDim listArray(0 To matchRowCount - 1, 0 To 14)

' 配置列表框
With Me.listboxActiveEscorts
  .Clear
  .ColumnCount = 15
  .ColumnHeads = True
  .ColumnWidths = "80,100,100,0,0,100,100,0,0,50,0,0,80,80,80"
End With

' 填充数组
ri = 0
For listCounter = 1 To objVisitorEscortList.ListRows.Count
    If objVisitorEscortList.ListRows(listCounter).Range.Cells(1, 14) = "" Then
        c = 0
        For ci = 0 To 14
            c = c + 1
            listArray(ri, ci) = objVisitorEscortList.ListRows(listCounter).Range.Cells(1, c).Value
        Next ci
        ri = ri + 1 ' 符合条件才递增行索引
    End If
Next listCounter

' 赋值给列表框
Me.listboxActiveEscorts.List = listArray

MsgBox "当前共有 " & Me.listboxActiveEscorts.ListCount & " 条活跃陪同记录", vbOKOnly

End Sub

改动说明 #

• 新增符合条件行数统计逻辑，避免循环内频繁扩容数组
• 修正列索引变量c的重置逻辑，避免读取不存在的列
• 用Me指代当前用户窗体，代码更简洁兼容性更好
• 增加无符合条件数据的兼容处理，避免空数组赋值报错

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