Question

我正在尝试使用来自多个ListObject的条目填充ListBox。但是并不是所有条目都应该填充，只有那些在ListObject的列中具有特定值的条目。

实施例： ListObjects由3列组成：[Name]，[Size]，[Position]

如果[Position]列中的值为“Top”，则ListObject1到ListObject5的所有条目都应填充到ListBox中。

基于该结果的下一个问题：然后我怎么能在第二个ListBox中显示所有依赖的ListObject的条目，其中[Position]不是“Top”。换句话说，并非所有ListObject中不是“Top”的条目都应该显示在第二个LIstBox中，只显示特定ListObject中可能的条目，其中第一个ListBox中选取的值匹配。

我的想法可能很奇怪，但是如何创建一个全新的表（可能是一个数组），它包含所有ListObjects中的所有条目，这些条目将在打开UserForm时生成，然后向其添加第三列 - [ListObjectNumber ] - 包含来自此信息来自Table的信息，这将有助于第二个ListBox仅显示正确的条目......但是这可能是太遥远了。

感谢您的帮助！

Answer 1

在如此布局的电子表格中：

通过主页选项卡格式化为＆＃34;格式为表＆＃34 ;;这会创建ListObjects 自动命名为＆＃34;表1＆＃34;，＆＃34;表2＆＃34;，＆＃34;表3＆＃34;，＆＃34;表4＆＃34;，＆＃34;表5＆＃34;
名为＆＃34; listbox＆＃34;例如
添加了ActiveX命令按钮，在此示例中显示名为frmListbox的用户表单：
```
Sub Button2_Click()
    frmListbox.Show
End Sub
```

    Private Sub cmdPopulate_Click()
        Dim ws As Worksheet
        Dim table As ListObject
        Dim rng As Range
        Dim i As Long, j As Long, criteriaRow As Long, lastCol As Long
        Dim myarray() As String

        With Me.lbUsed

            'Set relevant sheetname (or create loop for worksheets)
            Set ws = Sheets("listbox")

            criteriaRow = -1
            For Each table In ws.ListObjects
                'Set relevant range/table
                'Remember: top row are headings
                Set rng = ws.Range(table)

                'Remember: last colum not displayed in listbox (-1) for this example
                lastCol = rng.Columns.Count - 1

                .Clear
                .ColumnHeads = False
                .ColumnCount = lastCol

                'Remember: leave out row 0; column headings
                For i = 1 To rng.Rows.Count
                    If (rng.Cells(i, 3) = "Top") Then
                        criteriaRow = criteriaRow + 1
                        'Columns go in first demension so that rows can resize as needed
                        ReDim Preserve myarray(lastCol, criteriaRow)
                        For j = 0 To lastCol
                            myarray(j, criteriaRow) = rng.Cells(i, j + 1)
                        Next    'Column in table
                    End If
                Next    'Row in table
            Next    'Table (ListObject)

            'Place array in natural order to display in listbox
            .List = TransposeArray(myarray)

            'Set the widths of the column, separated with a semicolon
            .ColumnWidths = "100;75"
            .TopIndex = 0
        End With
    End Sub

    Public Function TransposeArray(myarray As Variant) As Variant
        Dim X As Long
        Dim Y As Long
        Dim Xupper As Long
        Dim Yupper As Long
        Dim tempArray As Variant

        Xupper = UBound(myarray, 2)
        Yupper = UBound(myarray, 1)
        ReDim tempArray(Xupper, Yupper)
        For X = 0 To Xupper
            For Y = 0 To Yupper
                tempArray(X, Y) = myarray(Y, X)
            Next Y
        Next X
        TransposeArray = tempArray
    End Function

对于第二个问题：

下面的代码示例显示了当点击名为lstDisorder的列表中的项目时，如何使用电子表格中命名范围的值填充下一个名为lstTreatment的列表框。

Private Sub lstDisorder_Click()
Dim x As Integer

x = lstDisorder.ListIndex
Select Case x
    Case Is = 0
        lstTreatment.RowSource = "Depression"
    Case Is = 1
        lstTreatment.RowSource = "Anxiety"
    Case Is = 2
        lstTreatment.RowSource = "OCD"
    Case Is = 3
        lstTreatment.RowSource = "Stubstance"
    End Select
End Sub

这是另一种方法：

Private Sub lstTeam_Click()

    Dim colUniqueItems      As New Collection
    Dim vItem               As Variant
    Dim rFound              As Range
    Dim FirstAddress        As String

    'First listBox
    Me.lstItems.Clear

    'populate first listBox from range on worksheet
    With Worksheets("Team").Range("A2:A" & (Cells(1000, 1).End(xlUp).row))
        'Find what was clicked in first listBox
        Set rFound = .Find(what:=lstTeam.Value, LookIn:=xlValues, lookat:=xlWhole)
        'If something is selected, populate second listBox
        If Not rFound Is Nothing Then
            'Get the address of selected item in first listBox
            FirstAddress = rFound.Address
            On Error Resume Next
            Do
                'Add the value of the cell to the right of the cell selected in first listBox to the collection
                colUniqueItems.Add rFound.Offset(, 1).Value, CStr(rFound.Offset(, 1).Value)
                'Find the next match in the range of the first listBox
                Set rFound = .FindNext(rFound)
            'Keep looking through the range until there are no more matches
            Loop While rFound.Address <> FirstAddress
            On Error GoTo 0
            'For each item found and stored in the collection
            For Each vItem In colUniqueItems
                'Add it to the next listBox
                Me.lstItems.AddItem vItem
            Next vItem
        End If
    End With

End Sub

这里是listBox的一个很好的资源，它展示了如何populate ListBox from an Array以及如何从ListBox1到ListBox2等获取所选项目。

VBA - 从多个ListObjects填充ListBox

1 个答案: