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

Posted 2023-04-19

【中文标题】ListBox（用户窗体）VBA中的多列

【英文标题】：Multiple columns in ListBox (Userform) VBA

【发布时间】：2021-01-02 20:05:16

【问题描述】：

在我的用户窗体的列表框中显示多个列时遇到问题。 一切正常，直到我的列数最大为 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，列宽也可以。 运行我的代码后，失败代码是运行时错误“380”：无法设置列表属性。无效的属性值。一开始我在想可能是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

你能支持我吗？

【参考方案1】：

分配给.Columnproperty 可以避免转置

作为 @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

【讨论】：

问题解决了！谢谢 T.M.这对我来说是个好教训。非常感谢你，祝你一切顺利！

@PawelU - 很好，问题已经解决了，你知道了，但我不打算让你接受这篇文章作为首选答案，并且因为 Dy.Lee 展示了同时不接受他的方法要走的路:-)

关于 10 列限制的进一步阅读 Populate listbox with multiple columns;使用数组方法而不是.AddItem 方法可以解决这个问题；一种解决方法是结合这两种方法 - c.f. here

【参考方案2】：

列表框的列索引也是从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

【讨论】：

一如既往的好又快，点赞。 - 友好提示：您可以无需转置，只需通过If n Then .Column = vResult 将结果分配给列表框.Column 属性，无需任何其他条件。 - 就我个人而言，我只会Redim 2 次（当开始到可能的边界最大值并且在循环之外第二次也是最后一次时）。 - 仅供参考，我可能对类似的问题感兴趣 here 我也提到了你的一个老帖子

拍得好！它运作良好。但是如何通过精确查找来解决问题。例如：如果我在第二列中有类似“X1”和“X11”的值，并且输入值将是“X1”，那么它会找到并显示两个结果。

@PawelU If vDB(i, 2) = FindDMC.Value Then 了解确切的发现；如果您想不区分大小写比较，则必须比较通过LCase() 或UCase() 转换的两个项目:-)

@T.M.，谢谢。现在我知道你在说什么了。但是，您在循环外部编写结果数组，但在循环内部使用动态数组更有效。一个常见的误解是提前指定数组大小更快，但在实际测试中，通过将数组加一来赋值更快。

@Dy.Lee - 感谢您的回复，很高兴阅读您的有用帖子。 - 我很高兴支持改进.Column 分配。 - 至于第二点，你的提示对我来说是新的，它值得用不同的行/列参数进行测试，如果有某种妥协redimming部分......或者你有更多数据集的具体测试结果是否偶然？