ListBox 中的多列（用户窗体）VBA

Question

我在用户窗体的列表框中显示多列时遇到问题。一切正常，直到我的列数最大为 10。

我的代码：

Private Sub FindButton_Click()
    ListBoxResult.Clear
    ListBoxResult.ColumnCount = 14
    Dim RowNum As Long
    RowNum = 1
    Do Until Sheets("db").Cells(RowNum, 1).Value = ""
        If InStr(1, Sheets("db").Cells(RowNum, 2).Value, FindDMC.Value, vbTextCompare) > 0 Then
            On Error GoTo next1
            ListBoxResult.AddItem Sheets("db").Cells(RowNum, 1).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 2) = Sheets("db").Cells(RowNum, 2).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 3) = Sheets("db").Cells(RowNum, 3).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 4) = Sheets("db").Cells(RowNum, 4).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 5) = Sheets("db").Cells(RowNum, 5).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 6) = Sheets("db").Cells(RowNum, 6).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 7) = Sheets("db").Cells(RowNum, 7).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 8) = Sheets("db").Cells(RowNum, 8).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 9) = Sheets("db").Cells(RowNum, 9).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 10) = Sheets("db").Cells(RowNum, 10).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 11) = Sheets("db").Cells(RowNum, 11).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 12) = Sheets("db").Cells(RowNum, 12).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 13) = Sheets("db").Cells(RowNum, 13).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 14) = Sheets("db").Cells(RowNum, 14).Value
            ListBoxResult.List(ListBoxResult.ListCount - 1, 15) = Sheets("db").Cells(RowNum, 15).Value
        End If
next1:
        RowNum = RowNum + 1
    Loop
End Sub

ListBoxResult.ColumnCount 属性为 14，列宽也可以。运行我的代码后，失败代码是运行-time error '380': Could not set the List 属性。属性值无效。一开始我在想可能是ListBox有列数限制，结果在网上找到了60列的ListBox。

我也在尝试这个，但还是不行：

Private Sub Browser_RMA_Initialize()
 
ListBoxResult.RowSource = "db!a1:z1"
ListBoxResult.ColumnCount = 14
ListBoxResult.ColumnWidths = "50;50;50;50;50;50;50;50;50;50;50;50;50;50;"
ListBoxResult.ColumnHeads = True
 
End Sub

你能支持我吗？

Answer 1

listbox的列索引也是从0开始，additem的索引号应该是0，而你在末尾指定了15，那么列数就变成了16，所以报错是因为超过了第14列.

用数组比较方便

Private Sub FindButton_Click()

    Dim Ws As Worksheet
    Dim vDB As Variant, vResult()
    Dim i As Long, j As Integer, n As Long
    Set Ws = Sheets("db")
    vDB = Ws.Range("a1").CurrentRegion
    For i = 1 To UBound(vDB, 1)
        If InStr(1, vDB(i, 2), FindDMC.Value, vbTextCompare) > 0 Then
            n = n + 1
            ReDim Preserve vResult(1 To 14, 1 To n)
            For j = 1 To 14
                vResult(j, n) = vDB(i, j)
            Next
        End If
    Next i
    With ListBoxResult
        .Clear
        .ColumnCount = 14
        .ColumnWidths = "50;50;50;50;50;50;50;50;50;50;50;50;50;50;"
        If n Then
            If n = 1 Then
                .Column = vResult
            Else
                .List = WorksheetFunction.Transpose(vResult)
            End If
            
        End If
    End With
    
End Sub

Answer 2

分配给.Column属性避免转置

作为@Dy.Lee 有效且已被接受的数组方法的最新补充（请参阅我的评论），我演示了一种如何避免重复重新调光 [4] 和转置 [5]:

Option Explicit                                  ' declaration head of UserForm code module

Private Sub FindButton_Click()
    '[0] where to search
    Const SearchCol As Long = 2                  ' get search items from 2nd column
    '[1] define data set
    Dim data As Variant
    data = Tabelle1.Range("A1").CurrentRegion    ' << change to your project's sheet Code(Name)
    Dim ii As Long: ii = UBound(data, 1)         ' row count
    Dim jj As Long: jj = UBound(data, 2)         ' column count
    '[2] provide for sufficient result rows (array with converted row : columns order)
    Dim results() As Variant
    ReDim Preserve results(1 To jj, 1 To ii)    ' redim up to maximum row count ii
    '[3] assign filtered data
    Dim i As Long, j As Integer, n As Long
    For i = 1 To ii
        If InStr(1, data(i, SearchCol), FindDMC.Value, vbTextCompare) > 0 Then
    ''  If data(i, SearchCol) = FindDMC.Value Then      ' exact findings
            n = n + 1
            For j = 1 To jj
                results(j, n) = data(i, j)
            Next
        End If
    Next i
    '[4] fill listbox with results
    With ListBoxResult
        .Clear
        .ColumnCount = 14
        .ColumnWidths = "50;50;50;50;50;50;50;50;50;50;50;50;50;50;"
        If n Then
            '[4] redimension only a 2nd time (& last time)
            ReDim Preserve results(1 To jj, 1 To n)
            '[5] assign results to listbox'es .Column property
            .Column = results       ' << .Column property avoids unnecessary transposing
        End If
    End With
End Sub

ListBox 中的多列（用户窗体）VBA

Multiple columns in ListBox (Userform) VBA

excel

vba

listbox

multiple-columns

userform