Заполнение списка ComboBox из кода VBA Excel по условию в зависимости от выбранного значения в другом элементе управления ComboBox на примере ФИО.
Пример для заполнения ComboBox по условию
Описание примера по заполнению списка ComboBox по условию в зависимости от выбранного значения в другом элементе управления ComboBox.
1. Исходная таблица со списками фамилий, имен и отчеств для заполнения элементов управления ComboBox из кода VBA Excel:
Список ФИО отсортирован по алфавиту, что позволит без использования дополнительного кода VBA Excel заполнить ComboBox1 только уникальными фамилиями, а также облегчит поиск фамилии для выбора в раскрывающемся списке.
2. Пользовательская форма с элементами управления ComboBox1, ComboBox2 и ComboBox3 для фамилий, имен и отчеств с соответствующими им надписями:
3. Необходимо с помощью кода VBA Excel:
- заполнить список элемента ComboBox1 уникальными фамилиями;
- заполнить ComboBox2 именами, соответствующими выбранной фамилии в ComboBox1;
- заполнить ComboBox3 отчествами, соответствующими выбранной фамилии в ComboBox1 и выбранному имени в ComboBox2.
Условие заполнения следующего элемента ComboBox — выбранное значение в предыдущем поле со списком.
Заполнение ComboBox1 уникальными фамилиями
Заполняем список ComboBox1 фамилиями из таблицы с помощью кода VBA Excel при открытии пользовательской формы, используя событие UserForm_Initialize
:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
Private Sub UserForm_Initialize() Dim arr() As Variant, n As Long, i As Long With Worksheets("Лист5") 'Определяем количество строк в таблице n = .Cells(1, 1).CurrentRegion.Rows.Count 'Копируем фамилии из диапазона в массив arr = .Range(.Cells(1, 1), .Cells(n, 1)).Value End With For i = 2 To n 'Условие используем для добавления в список уникальных фамилий If arr(i - 1, 1) <> arr(i, 1) Then 'Добавляем очередную фамилию в список ComboBox1 ComboBox1.AddItem arr(i, 1) End If Next End Sub |
Фамилии из столбца таблицы копируются в массив для ускорения цикла, так как в массивах циклы работают быстрее, чем в диапазонах.
Заполнение ComboBox2 именами по условию
Когда мы выбираем значение в поле со списком ComboBox1, происходит событие ComboBox1_Change, которое будем использовать для автоматического заполнения элемента ComboBox2 именами, соответствующими выбранной фамилии:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
Private Sub ComboBox1_Change() Dim arr() As Variant, n As Long, i As Long With Worksheets("Лист5") 'Определяем количество строк в таблице n = .Cells(1, 1).CurrentRegion.Rows.Count 'Копируем фамилии и имена из диапазона в массив arr = .Range(.Cells(1, 1), .Cells(n, 2)).Value End With 'Очищаем ComboBox2 от элементов предыдущего списка ComboBox2.Clear For i = 2 To n 'Условие используем для добавления в список имен, соответствующих выбранной фамилии If arr(i, 1) = ComboBox1.Value Then 'Добавляем очередное имя в список ComboBox2 ComboBox2.AddItem arr(i, 2) End If Next With ComboBox2 'Если в списке один элемент, автоматически его выбираем If .ListCount = 1 Then .ListIndex = 0 End With End Sub |
Имена в ComboBox2 могут повторяться, так как отбор уникальных значений не производится. Если имена в списке ComboBox2 должны быть уникальными, можно сначала добавить их в объект Collection с отбором уникальных значений, а потом из объекта Collection скопировать имена с помощью цикла For Each ... Next
в ComboBox2:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 |
Private Sub ComboBox1_Change() Dim arr() As Variant, n As Long, i As Long, myCollection As New Collection, myElement As Variant With Worksheets("Лист5") 'Определяем количество строк в таблице n = .Cells(1, 1).CurrentRegion.Rows.Count 'Копируем фамилии и имена из диапазона в массив arr = .Range(.Cells(1, 1), .Cells(n, 2)).Value End With 'Очищаем ComboBox2 от элементов предыдущего списка ComboBox2.Clear For i = 2 To n 'Условие используем для добавления в список имен, соответствующих выбранной фамилии If arr(i, 1) = ComboBox1.Value Then 'Добавляем очередное уникальное имя в Collection On Error Resume Next myCollection.Add CStr(arr(i, 2)), CStr(arr(i, 2)) On Error GoTo 0 End If Next With ComboBox2 'Заполняем список элемента ComboBox2 именами из коллекции For Each myElement In myCollection .AddItem myElement Next myElement 'Если в списке один элемент, автоматически его выбираем If .ListCount = 1 Then .ListIndex = 0 End With End Sub |
Заполнение ComboBox3 отчествами по условию
Выбор одного из элементов в ComboBox2, как и автоматический выбор единственного элемента предыдущим кодом, вызывает событие ComboBox2_Change, которое будем использовать для автоматического заполнения элемента ComboBox3 отчествами, соответствующими выбранной фамилии в ComboBox1 и выбранному имени в ComboBox2:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
Private Sub ComboBox2_Change() Dim arr() As Variant, n As Long, i As Long With Worksheets("Лист5") 'Определяем количество строк в таблице n = .Cells(1, 1).CurrentRegion.Rows.Count 'Копируем фамилии, имена и отчества из диапазона в массив arr = .Range(.Cells(1, 1), .Cells(n, 3)).Value End With 'Очищаем ComboBox3 от элементов предыдущего списка ComboBox3.Clear For i = 2 To n 'Условие для добавления в список отчеств, соответствующих выбранным фамилии и имени If arr(i, 1) = ComboBox1.Value And arr(i, 2) = ComboBox2.Value Then 'Добавляем очередное отчество в список ComboBox3 ComboBox3.AddItem arr(i, 3) End If Next With ComboBox3 'Если в списке один элемент, автоматически его выбираем If .ListCount = 1 Then .ListIndex = 0 End With End Sub |
Отчества в ComboBox3 повторяться не могут, так как это означало бы, что в таблице есть два или более совершенно одинаковых ФИО.
Один из результатов работы кода VBA Excel по заполнению полей со списком ComboBox в зависимости от выбранного значения в другом элементе управления ComboBox на примере ФИО:
Если фамилия в списке встречается один раз, и ей соответствует одно имя, а фамилии и имени — одно отчество, тогда при выборе этой фамилии в элементе управления ComboBox1, имя и отчество в ComboBox2 и ComboBox3 выберутся автоматически.
Здорово!
Спасибо большое!
Добрый день!
Только знакомлюсь с VBA!
Не могли бы написать код к:
Имена в ComboBox2 могут повторяться, так как отбор уникальных значений не производится. Если имена в списке ComboBox2 должны быть уникальными, можно сначала добавить их в объект Collection с отбором уникальных значений, а потом из объекта Collection скопировать имена с помощью цикла For Each … Next в ComboBox2.
Здравствуйте, Александр!
Добавил в статью код для заполнения списка элемента управления ComboBox2 уникальными именами.
Спасибо, огромное!
Добрый день.
Подскажите, почему выбранное значение из списка может не подставляться в комбобокс?
У меня написан код по вашей статье: как заполнить комбобокс значениями по условию. Список значений в комбобоксе заполняется, но когда я выбираю то или иное значение оно в самом поле комбобокса не отображается. Если же я заполняю список значений комбобокса из диапозона без условий все срабатывает нормально.
Здравствуйте, Виктория!
Возможно, у вас неправильно применен метод ComboBox.Clear. Посмотрите, не тот ли ComboBox вы очищаете, в котором выбираете значение.
Именно его и очищаю. Описанный здесь код приведен для события Change, я же применяю для события DropButtonClick, чтобы значения добавлялись из массива, когда раскрывается список. И метод Clear применяю к этому комбобокс до добавления значений в него, иначе при каждом раскрытии списка значения начинают дублироваться.
Причем если начать вводить значение в комбобокс, которое есть в списке, он автоматически подставит его и будет отображать. Но при выборе значения мышью значение не заполняется:(
Доброго времени!
Было бы круто, если сам рабочий файл можно было бы скачать…
За статью — СПАСИБО!
Обсуждение закрыто.