VBA

Question

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

示例： ListObjects 由 3 列组成：[名称]、[大小]、[位置]

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

基于该结果的下一个问题：我如何才能在第二个 ListBox 中显示 [Position] 不是 "Top" 的依赖 ListObject 的所有条目。换句话说，并非所有 ListObjects 中不属于 "Top" 的所有条目都应显示在第二个 LIstBox 中，只有那些来自特定 ListObject 的可能条目与第一个 ListBox 中选取的值匹配。

我的想法可能有些奇怪，但是如何创建一个全新的 table（可能是一个数组）呢？它包含来自所有 ListObjects 的所有条目，这些条目将在打开用户窗体时生成，然后添加第三个它的列 - [ListObjectNumber] - 包含 Table 此信息的来源信息，这将有助于第二个 ListBox 仅显示正确的条目......但也许这太过分了。

感谢您的帮助！

Answer 1

在这样布局的电子表格中：

使用 "Format as Table" 通过“主页”选项卡格式化；这创建了 ListObjects 自动命名为 "Table1"、"Table2"、"Table3"、"Table4"、"Table5"
Sheet 命名为 "listbox" 例如
添加了 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

VBA - populate ListBox from multiple ListObjects

excel

listbox

listobject