Excel VBA：ListBox显示A列非空数据时遇下标越界错误求解决

我有一个动态工作表，希望仅在ListBox中显示A至F列里A列（Name列）不为空的数据。表格示例如下：

初始化时尝试了如下VBA代码，但出现subscript out of range错误：

Sub forListBoxShow()
    Dim ws As Worksheet, colList As Collection
    Dim arrData, arrList, i As Long, j As Long
    Set colList = New Collection
    Set ws = Worksheets("Sheet1")
    arrData = ws.Range("A1:F" & ws.Cells(ws.Rows.count, "A").End(xlUp).Row)
    ' build collection of row numbers
    For i = 2 To UBound(arrData)
            If arrData(i, 1) <> vbNullString Then
                colList.Add i, CStr(i)
            End If
    Next
    ReDim arrList(1 To colList.count + 1, 1 To UBound(arrData))
    For j = 1 To 6
        arrList(1, j) = arrData(1, j) ' header
        For i = 1 To colList.count
                arrList(i + 1, j) = arrData(colList(i), j)
        Next
    Next
    listBoxShow.Clear
    With Me.listBoxShow
        .ColumnCount = UBound(arrData, 2)
        .ColumnWidths = "50,50,70,40,90,90"
        .list = arrList
    End With
End Sub

即使为Name列中带有#VALUE!的单元格（Mark所在行）填充有效值，或修改判断条件为If Not arrData(i, 1) = "" Then，错误依然存在。

错误原因分析 #

1. 数组维度声明错误：原代码中ReDim arrList(1 To colList.count + 1, 1 To UBound(arrData))的第二个参数使用UBound(arrData)，但arrData是二维数组，UBound(arrData)返回的是行的最大下标，而非列数，正确应该用UBound(arrData, 2)获取列数，这是触发下标越界的核心原因。
2. 未处理错误值：当A列单元格为#VALUE!这类错误值时，直接执行arrData(i,1) <> vbNullString会触发运行时错误，导致代码中断。
3. 空数据场景未兼容：如果A列所有数据行都为空，colList.count为0，后续数组赋值逻辑可能出现异常。

修正后的代码 #

Sub forListBoxShow()
    Dim ws As Worksheet, colList As Collection
    Dim arrData, arrList, i As Long, j As Long
    Set colList = New Collection
    Set ws = Worksheets("Sheet1")
    
    ' 读取A1到F列的全部数据
    arrData = ws.Range("A1:F" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    
    ' 收集A列非空且非错误值的行号
    For i = 2 To UBound(arrData)
        If Not IsError(arrData(i, 1)) Then
            If arrData(i, 1) <> vbNullString Then
                colList.Add i, CStr(i)
            End If
        End If
    Next
    
    ' 无有效数据时直接清空ListBox并退出
    If colList.Count = 0 Then
        listBoxShow.Clear
        Exit Sub
    End If
    
    ' 正确声明结果数组：行=表头行+有效数据行，列=原数据列数
    ReDim arrList(1 To colList.Count + 1, 1 To UBound(arrData, 2))
    
    ' 填充表头
    For j = 1 To UBound(arrData, 2)
        arrList(1, j) = arrData(1, j)
    Next
    
    ' 填充有效数据行
    For i = 1 To colList.Count
        For j = 1 To UBound(arrData, 2)
            arrList(i + 1, j) = arrData(colList(i), j)
        Next
    Next
    
    ' 更新ListBox显示
    listBoxShow.Clear
    With Me.listBoxShow
        .ColumnCount = UBound(arrData, 2)
        .ColumnWidths = "50,50,70,40,90,90"
        .List = arrList
    End With
End Sub

关键修正说明 #

• 修正数组维度：用UBound(arrData, 2)替代UBound(arrData)，确保结果数组的列数与原数据一致。
• 增加错误值判断：通过Not IsError(arrData(i, 1))跳过错误值单元格，避免对比时触发错误。
• 兼容空数据场景：当无有效数据时直接清空ListBox，避免无效数组操作。

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