Поиск неизвестного значения в 3 столбце таблицы по известным значениям, расположенным в 1 и 2 столбцах той же строки, из кода VBA Excel.
Поиск значения в таблице
Исходные данные размещены в следующей таблице:
Необходим код VBA Excel, который будет находить значение в колонке «В процентах по стране» по заданным критериям «Возраст» и «Страна». Для реализации алгоритма используется следующая пользовательская форма:
При выборе возраста и страны из раскрывающихся списков (ComboBox), в текстовое поле (TextBox) автоматически записывается значение из 3 колонки, соответствующее первым двум критериям.
Код поиска значения
Весь код поиска неизвестного значения в таблице по заданным критериям размещается в модуле пользовательской формы.
В разделе «Declarations» модуля пользовательской формы объявляем общую переменную для всех процедур:
|
1 2 |
Option Explicit Dim n As Long 'Номер последней строки в таблице |
В эту переменную будет записываться номер последней строки исходной таблицы с данными.
Далее добавляем код инициализации формы, который будет выполняться перед ее отображением на экране:
|
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 29 |
'Настройка формы перед ее отображением Private Sub UserForm_Initialize() Dim myCell As Range, myCollection As Object, myElement As Variant 'Определяем номер последней строки в таблице n = Range("A1").CurrentRegion.Rows.Count 'Задаем возможность ввода значений только из списка ComboBox1.MatchRequired = True ComboBox2.MatchRequired = True 'Заполняем ComboBox1 уникальными значениями Set myCollection = New Collection On Error Resume Next For Each myCell In Range(Cells(3, 1), Cells(n, 1)) myCollection.Add CStr(myCell.Value), CStr(myCell.Value) Next myCell On Error GoTo 0 For Each myElement In myCollection Me.ComboBox1.AddItem myElement Next myElement 'Заполняем ComboBox2 уникальными значениями Set myCollection = New Collection On Error Resume Next For Each myCell In Range(Cells(3, 2), Cells(n, 2)) myCollection.Add CStr(myCell.Value), CStr(myCell.Value) Next myCell On Error GoTo 0 For Each myElement In myCollection Me.ComboBox2.AddItem myElement Next myElement End Sub |
Теперь необходимо добавить код VBA Excel, который будет искать значение в 3 столбце таблицы при изменении значения в любом из полей со списками. Для этого будем использовать процедуры событий Change объектов ComboBox1 и ComboBox2 (тексты внутри процедур одинаковые):
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
Private Sub ComboBox1_Change() Dim i As Long 'Если одно из полей со списком пустое, выходим из процедуры If ComboBox1 = "" Or ComboBox2 = "" Then Exit Sub For i = 3 To n If CStr(Cells(i, 1)) = ComboBox1 And CStr(Cells(i, 2)) = ComboBox2 Then TextBox1.Text = Cells(i, 3) * 100 & "%" Exit Sub End If Next End Sub Private Sub ComboBox2_Change() Dim i As Long 'Если одно из полей со списком пустое, выходим из процедуры If ComboBox1 = "" Or ComboBox2 = "" Then Exit Sub For i = 3 To n If CStr(Cells(i, 1)) = ComboBox1 And CStr(Cells(i, 2)) = ComboBox2 Then TextBox1.Text = Cells(i, 3) * 100 & "%" Exit Sub End If Next End Sub |
Результат работы кода:
Таблица с объединенными ячейками
Если предыдущий код VBA Excel применить к следующей таблице:
в списке объекта ComboBox2 на второй позиции появится пустая строка, а результат в текстовом поле не всегда будет соответствовать действительности.
От пустой строки будем избавляться, удаляя ее из коллекции сразу после добавления:
|
1 2 3 4 5 6 7 8 9 10 11 12 |
'Заполняем ComboBox2 уникальными значениями Set myCollection = New Collection On Error Resume Next For Each myCell In Range(Cells(3, 2), Cells(n, 2)) myCollection.Add CStr(myCell.Value), CStr(myCell.Value) 'Удаляем из коллекции пустую строку If myCell = "" Then myCollection.Remove (myCollection.Count) Next myCell On Error GoTo 0 For Each myElement In myCollection Me.ComboBox2.AddItem myElement Next myElement |
Чтобы поиск значения в 3 столбце всегда завершался верным результатом, заменим код процедур ComboBox1_Change и ComboBox2_Change на следующий:
|
1 2 3 4 5 6 7 8 9 10 11 12 |
Dim i As Long, s As String If ComboBox1 = "" Or ComboBox2 = "" Then Exit Sub For i = 3 To n s = CStr(Cells(i, 2)) 'Если в переменной s содержится пустая строка, 'записываем в нее значение из первой непустой ячейки выше If s = "" Then s = CStr(Cells(i, 2).End(xlUp)) If CStr(Cells(i, 1)) = ComboBox1 And s = ComboBox2 Then TextBox1.Text = Cells(i, 3) * 100 & "%" Exit Sub End If Next |
Добрый день!
Мне нужно, чтобы второй комбобокс выбирал числа вместо текста. Какие изменения должны быть в коде?
Пробовал, как здесь, но не работает.
Ячейки таблицы не объединены.
Добрый день! Если в ячейке содержится число, его надо преобразовать в текст. Замените в процедурах
ComboBox1_Change()иComboBox2_Change()строку:на строку:
Здравствуйте!
Подскажите пожалуйста как можно реализовать поиск по трем значениям:
например, таблица, в которой строки это дни месяца, а столбцы это температура, в ячейках числовое значение температуры
Как можно в такой таблице найти дни месяца, у которых и 1, и 17 и 29 числа было +15
Обсуждение закрыто.