VBA - заполнить ListBox из нескольких объектов ListObject

Question

Я пытаюсь заполнить ListBox записями из нескольких объектов ListObject. Но не все записи должны быть заполнены, только те, которые имеют определенное значение в столбце ListObject.

Пример: Объекты ListObject состоят из 3 столбцов: [Имя], [Размер], [Позиция]

Все записи от ListObject1 до ListObject5 должны быть заполнены в ListBox, если значение в столбце [Position] равно "Top".

Следующий вопрос на основе этого результата: Как я могу затем во втором ListBox отобразить все записи зависимого ListObject, где [Position] не является "Top". Другими словами, не все записи, которые не являются «Top» из всех объектов ListObject, должны отображаться во втором LIstBox, только те возможные записи из определенного ListObject, где совпадает значение, выбранное в первом ListBox.

Мои мысли могут быть странными, но как насчет создания совершенно новой таблицы (возможно, массива), которая состоит из всех записей всех объектов ListObject, которые будут сгенерированы при открытии пользовательской формы, а затем добавит в нее третий столбец - [ListObjectNumber ] - которая состоит из информации, из которой из этой таблицы поступает эта информация, которая поможет второму ListBox отображать только правильные записи ... но, возможно, это слишком далеко вперед.

Спасибо за вашу помощь!

Answer 1

В таблице, изложенной так:

• Отформатирован на вкладке «Главная» с «Формат таблицы»; это создает ListObjects автоматически именуется как «Table1», «Table2», «Table3», «Table4», «Table5»
• Лист с именем "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, который показывает, как заполнить ListBox из массива и как получить выбранные элементы из ListBox1 в ListBox2 и другие.