Excel VBA заполнение списка со значениями из выбранного листа с помощью циклов

Question

У меня есть 2 списка в форме пользователя. Когда пользователь щелкает элемент (имя рабочего листа) в одном из полей, другое поле списка должно автоматически заполниться значениями в столбце D конкретного рабочего листа, который они выбрали. Я также не хочу, чтобы какие-либо повторяющиеся значения отображались. Как я могу сделать это с помощью циклов?

Answer 1

Ну, здесь должно произойти несколько вещей.

Поскольку вам не удалось указать имена ваших списков, мы используем общие формы:

• ListBox1 - это список со списком имен ваших листов
• ListBox2 - это список для автоматического заполнения из столбца D

Во-первых, вам нужно убедиться, что listBox1инициализируется с вашими значениями листа.Пример того, как вы могли бы сделать это:

Private Sub UserForm_Initialize()

    'MUST BE PLACED IN USERFORM CODE MODULE!!
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        Me.ListBox1.AddItem ws.Name
    Next ws

End Sub

Выше не требуется для вашей задачи, но ваша пользовательская форма предварительно заполняется требуется .

Теперь вы захотите посмотреть на событие ListBox1_Change().Опять же, если ваш список не имеет названия ListBox1, вам нужно будет изменить его в дополнительном имени.

Private Sub ListBox1_Change()

    'MUST BE PLACED IN USERFORM CODE MODULE!!
    Dim wsSelected As Worksheet
    Set wsSelected = ThisWorkbook.Worksheets(Me.ListBox1.Value)

    With wsSelected

        Me.ListBox2.List = rngToUniqueArr(.Range(.Cells(1, "D"), .Cells( _
                lastRow(wsSelected, "D"), "D")))

    End With

End Sub

Function rngToUniqueArr(ByVal rng As Range) As Variant
    'Reference to [Microsoft Scripting Runtime] Required
    Dim dict As New Scripting.Dictionary, cel As Range
    For Each cel In rng.Cells
        dict(cel.Value) = 1
    Next cel
    rngToUniqueArr = dict.Keys
End Function

Function lastRow(ws As Worksheet, Optional col As Variant = 1) As Long
    With ws
        lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
    End With
End Function

Sub rngToUniqueArr - это то, что я сохранил в моем PERSONAL.XLSB книга, это полезная функция.Это возьмет диапазон ввода, создаст словарь уникальных значений и выведет его в массив.

Выше необходимо установить ссылку на Microsoft Scripting Runtime в Инструменты > Ссылки

В вашем ListBox1_Change() событии wsSelected - это лист, который вы выбрали из ListBox1, и вы добавляете массив из rngToUniqueArr в ListBox2.