主页 / coding / 问题 / 79527932
Accepted
Shiela
Asked: 2025-03-23 02:43:58 +0800 CST

如何在 Excel 的第 1 列不等于空单元格的情况下显示列表框中的项目

  • 772

这里有一张动态表，我只想显示到列表框中，A 到 F 列，其中 A 列/名称不等于空/空单元格。

一个 乙 碳 德 埃 F
姓名 分数 复杂 积分 总分 总计（无积分）
汤姆 5 3 0.25 105.00% 100.00%
布伦达 5 4 0.5 110.00% 100.00%
标记 5 - ＃价值！ ＃价值！
- ＃价值！ ＃价值！
- ＃价值！ ＃价值！

我在初始化期间尝试了以下操作：

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

但是我遇到了subscript out of range错误。我还尝试向名称为“Mark”的单元格添加实际值#VALUE!，但遇到了同样的错误。（对于带有 #VALUE! 的单元格 - 它具有默认公式并且有用途）。还尝试了上述代码，但遇到了同样的错误：

If Not arrData(i, 1) = "" Then

我很感谢你的帮助。

excel

2 个回答

  1. 使用匹配的数据行填充列表框

    表格和表格

    Sub forListBoxShow()
    
    ' Reference the range.
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    'Set rg = rg.EntireRow.Columns("A:F") ' if necessary
    
    ' Return the range values in the source Variant array.
    Dim sData() As Variant: sData = rg.Value
    Dim sRowsCount As Long: sRowsCount = UBound(sData, 1)
    Dim ColumnsCount As Long: ColumnsCount = UBound(sData, 2)
    
    ' Define a collection to hold the matching row numbers.
    Dim collRows As Collection: Set collRows = New Collection
    collRows.Add 1 ' headers
    
    ' Loop through the values of the first column and for each non-blank
    ' value, add the row number to the collection.
    Dim sRow As Long
    For sRow = 2 To sRowsCount ' skip headers
        If Len(CStr(sData(sRow, 1))) > 0 Then collRows.Add sRow
    Next sRow
    
    ' Define the destination String array.
    Dim dRowsCount As Long: dRowsCount = collRows.Count
    Dim dData() As String: ReDim dData(1 To dRowsCount, 1 To ColumnsCount)
    
    ' Loop through the elements (source rows) of the collection
    ' and copy the values of the matching rows to the destination array.
    ' Account for errors.
    Dim dRow As Long, Col As Long
    For dRow = 1 To dRowsCount
        sRow = collRows(dRow)
        For Col = 1 To ColumnsCount
            If IsError(sData(sRow, Col)) Then
                dData(dRow, Col) = rg.Cells(sRow, Col).Text
            Else
                dData(dRow, Col) = sData(sRow, Col)
            End If
        Next Col
    Next dRow
    
    ' Populate the list box.
    With Me.listBoxShow
        .ColumnCount = ColumnsCount
        .ColumnWidths = "50,50,70,40,90,90"
        .List = dData
    End With

End Sub
    • 2
  2. Best Answer

    subscript out of range当数组索引超出数组声明的大小时，通常会出现此错误。UBound(arrData, 2)应该用作ReDim第二维的最大值。

    ReDim arrList(1 To colList.Count + 1, 1 To UBound(arrData, 2))
    • 1

相关问题