Excel VBA Макросы: Поиск значения в другом столбце.

Автор moland, 03 ноября 2017, 15:07

moland

Здравствуйте. Подскажите с кодом.

Мне нужно чтобы код в 6-ой столбец листа "MaterialsNorms" внес значения толщины стенки  из листа "справочник" -столбец 2.
Соответствующие диаметрам 75, 90, 110, 160 (прописаны в столбце 4).
А остальные строки (в столбце 4 которых нет значений) удалил, но это по возможности.

Порядок действия я вижу такой (номера столбцов привел для примера).
1. Взять первое значение, находящейся в столбце 4 - допустим это значение 32. Значения находятся в столбце: от 10-й строки до последней заполненной строки в этом столбце.
2. Найти первое попавшейся это значение (32) в другом столбце остановить цикл и запомнить номер строки в котором это значение находится.
3. Вывести значение из соседнего столбца той же строки в которой нашли 32 (пункт 2) и занести его в соседнюю ячейку того же столбца откуда взяли первое значение (пункт 1).

Надеюсь понятно изложил.

[вложение удалено администратором]

Администратор

Если данных немного (меньше 100 тыс. строк), то можно использовать эксель-функции, т.к. с ними проще код. Если данных много, то эксель-функции будут сильно замедлять работу макроса.
Макрос также удаляет строки, у которых пусто в столбце 4.

Макрос
Sub макрос()
   
    Dim sh_mat As Worksheet, sh_spravka As Worksheet
    Dim i As Long, lr As Long
   
   
    '1. Отключение монитора, чтобы ускорить макрос.
    Application.ScreenUpdating = False
   
    '2. Присваиваем имена листам, с которыми надо работать, чтобы по этим именам обращаться к листам.
    Set sh_mat = Worksheets("MaterialsNorms")
    Set sh_spravka = Worksheets("Справочник")
   
    '3. Удаление строк на листе "MaterialsNorms", у которых пусто в столбце 4.
    ' Поиск последней строки. Не должно быть скрытых строк, т.к. End не ищет в скрытых строках.
    lr = sh_mat.Cells(sh_mat.Rows.Count, 2).End(xlUp).row
    ' Удаление.
    For i = lr To 10 Step -1
        If sh_mat.Cells(i, 4).Value = "" Then
            sh_mat.Rows(i).Delete
        End If
    Next i
   
    '4. Заполнение столбца 6 на листе "MaterialsNorms".
    lr = sh_mat.Cells(sh_mat.Rows.Count, 4).End(xlUp).row
    For i = 10 To lr
        ' Для заполнения используется эксель-функция ВПР.
        sh_mat.Cells(i, 6).Value = _
            WorksheetFunction.VLookup(sh_mat.Cells(i, 4).Value, sh_spravka.Columns("A:B"), 2, 0)
    Next i
   
    '5. Вкл. монитора.
    Application.ScreenUpdating = True
   
    '6. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub
[свернуть]

moland

Спасибо.
Ваш код это и есть код с использованием функций эксель (ВПР в частности)?

Администратор


moland

Вариант с эксель-функцией мне не подходит, т.к. планирую использовать макрос в аксесе. Как сделать то же самое, но без эксель-функции, чтобы работало и в аксесе? Макрос вообще не будет работать с экселем.

Файл во вложении. Нужно вставить значения толщины стенки в лист MaterialsNorms.
На листе MaterialsNorms нужно заполнить столбцы F, I, K на основе столбца с D1.

Администратор

Макрос
Sub macro()
   
    Dim sh_mats As Worksheet, sh_spravka As Worksheet
    Dim spr_rows As Collection, spr_data()
    Dim arr(), r As Long, lr As Long, i As Long
   
   
    '1. Отключение монитора для ускорения макроса.
        ' Это нужно для работы с эксель-листом. Для аксеса это не надо.
    Application.ScreenUpdating = False
   
    '2. Присваиваем листам имена "sh_mats" и "sh_spravka", чтобы удобно писать код.
    Set sh_mats = Worksheets("MaterialsNorms")
    Set sh_spravka = Worksheets("Справочник")
   
    '3. Запись информации из справки в элементы. В коллекции "spr_rows" будут D1 и номера строка, где
        ' находятся D1. В массиве "spr_data" будут данные из справки, которые надо вставить на лист-результат.
        ' Коллекция используется для ускорения макроса.
    '1) Поиск последней строки. End не работает со скрытыми строками.
    lr = sh_spravka.Cells(sh_spravka.Rows.Count, "A").End(xlUp).row
    '2) Запись данных в массив. С массивом макрос быстрее работает, чем с объектами.
    spr_data() = sh_spravka.Range("A1:D" & lr).Value
    '3) Создание коллекции.
    Set spr_rows = New Collection
    '4) Запись D1 и номеров строк в коллекцию.
    For i = 2 To UBound(spr_data, 1)
        ' В параметр "Key" у коллекции можно записать только тип String.
        spr_rows.Add Item:=i, key:=CStr(spr_data(i, 1))
    Next i
   
    '4. Запись данных на лист-результат.
    '1) Поиск последней строки. End не работает со скрытыми строками.
    lr = sh_mats.Cells(sh_mats.Rows.Count, "D").End(xlUp).row
    '2) Копирование столбцов D в массив, чтобы ускорить макрос.
    arr() = sh_mats.Range("D1:D" & lr)
    '3) Запись данных на лист-результат.
    For i = 10 To UBound(arr, 1)
        ' Если в столбце D не пусто.
        If arr(i, 1) <> "" Then
            ' Запись в переменную "r" номера строки из справки.
            r = spr_rows(CStr(arr(i, 1)))
            ' Запись данных на лист-результат.
            sh_mats.Cells(i, "F").Value = spr_data(r, 2)
            sh_mats.Cells(i, "I").Value = spr_data(r, 3)
            sh_mats.Cells(i, "K").Value = spr_data(r, 4)
        End If
    Next i
   
    '5. Вкл. монитора.
    Application.ScreenUpdating = True
   
    '6. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub
[свернуть]

Администратор

Ясно, я просто задачу неправильно понял, я думал, что на основе D1 заполняется один столбец, на основе столбца D2 другой столбец.
Подумаю, что сделать.

Администратор


moland

Спасибо! Все работает.
Раньше  слышал о массивах, благодаря вам узнал о коллекциях. и сейчас набираюсь информации и у меня возник вопрос.
Существуют еще словари: они на мой первый взгляд похожи на коллекции, там тоже есть элементы и ключи.
Есть ADD.
Вы случаем не знаете чем отличаются коллекции от словарей, что такое Microsoft Scripting Runtime? Какие преимущества у коллекции по сравнению со словарями и наоборот.


Администратор

Коллекция выгоднее массива по скорости. Это заметно, если у вас данных будет больше 100 тысяч строк. Если меньше 100 тыс. строк, то разница не будет очень заметной по времени.

Создайте темы:
1) в чём разница между коллекцией и словарём?
2) что такое Microsoft Scripting Runtime?
3) что такое ADO (или как-то по-другому спросите, как вам удобнее)?