Доброго времени суток помогите написать макрос Сравнение таблиц в Excel, реализацию я уже нашел но меня не устраивает скорость работы с большим количеством строк, можно ли как- то увеличить скорость цикла или новый подход? у меня в 2х таблицах по 20 000 строк выполняются они очень долго.
Через ВПР не предлагать именно макрос!

Для начала напишем алгоритм наших действий по сравнению таблиц.
Для этого откроем вкладку Вид ленты функций Excel. Щелкнем на нижнюю часть со стрелкой кнопки Макросы. В открывшемся подменю выберемЗапись макроса. В результате начнется запись нового макроса. Поскольку код мы будем формировать вручную, то еще раз зайдем в подменю макросов и выберем Остановить запись. Далее еще раз войдем в подменю макросов и выберем Макросы.
В появившемся диалоге выделим наш макрос и нажмем Изменить.
На экране откроется окно редактора макросов Visual Basic for Applications. В области кода (правая верхняя область) отображается код только что созданного пустого макроса.

В процедуру Макрос1 (между объявлениями начала и конца процедуры: Sub и End Sub) необходимо вставить код, решающий поставленную задачу. Образец кода представлен ниже.?
Результат решения задачи:

Через ВПР не предлагать именно макрос!

Для начала напишем алгоритм наших действий по сравнению таблиц.
- Определим диапазоны данных первой и второй таблицы, то есть найдем последние значимые строки и сохраним их номера в переменных (последняя строка таблицы 1 - last_i и последняя строка таблицы 2 - last_j).
- Начнем проходить по каждой строке таблицы 2 (внешний цикл), данные из которой нужно перенести в таблицу 1. С первой строки данных (в примере это строка 3) до последней строки таблицы 2.
- Для каждой строки таблицы 2 определим идентификатор строки, путем формирования строки, содержащей полный адрес квартиры (значения из нескольких колонок, разделенные дефисами).
- Начнем проходить по каждой строке таблицы 1 (внутренний цикл) с первой строки данных (в примере это строка 3) до последней строки таблицы 1, определяя при этом идентификатор строки.
- Сравним значения идентификаторов строк таблицы 1 и таблицы 2.
- Если идентификаторы равны, перепишем ФИО покупателя из ячейки таблицы 2 в соответствующую ячейку таблицы 1; прервем внутренний цикл по таблице 1 и перейдем к следующей строке таблицы 2 (переход к п.2).
Для этого откроем вкладку Вид ленты функций Excel. Щелкнем на нижнюю часть со стрелкой кнопки Макросы. В открывшемся подменю выберемЗапись макроса. В результате начнется запись нового макроса. Поскольку код мы будем формировать вручную, то еще раз зайдем в подменю макросов и выберем Остановить запись. Далее еще раз войдем в подменю макросов и выберем Макросы.
В появившемся диалоге выделим наш макрос и нажмем Изменить.
На экране откроется окно редактора макросов Visual Basic for Applications. В области кода (правая верхняя область) отображается код только что созданного пустого макроса.

В процедуру Макрос1 (между объявлениями начала и конца процедуры: Sub и End Sub) необходимо вставить код, решающий поставленную задачу. Образец кода представлен ниже.?
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 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | Sub Макрос1() ' ' Макрос1 сравнение двух таблиц с использованием макроса VBA ' ' ссылка на первый лист книги Dim sheet1 As Worksheet Set sheet1 = ActiveWorkbook.Sheets(1) ' ссылка на второй лист книги Dim sheet2 As Worksheet Set sheet2 = ActiveWorkbook.Sheets(2) ' строка для хранения идентификатора строки первой таблицы Dim str1 As String ' строка для хранения идентификатора строки второй таблицы Dim str2 As String ' позиция курсора (номер строки) в первой таблице Dim i As Integer i = 3 Dim last_i As Integer last_i = 3 ' позиция курсора (номер строки) во второй таблице Dim j As Integer j = 3 Dim last_j As Integer last_j = 3 ' определяем последнюю значимую строку первой таблицы (последняя строка, в первой колонке которой есть значение) For Each Cell In sheet1.Range("A:A") If Cell.Row > 2 Then If Cell.Value > "" Then last_i = Cell.Row Else Exit For End If End If Next Cell ' определяем последнюю значимую строку второй таблицы (последняя строка, в первой колонке которой есть значение) For Each Cell In sheet2.Range("A:A") If Cell.Row > 2 Then If Cell.Value > "" Then last_j = Cell.Row Else Exit For End If End If Next Cell ' пробегаем по строкам второй таблицы (внешний цикл) For j = 3 To last_j ' определяем идентификатор текущей строки str2 = sheet2.Cells(j, 1).Value & "-" & sheet2.Cells(j, 2).Value & "-" & sheet2.Cells(j, 3).Value & "-" & sheet2.Cells(j, 4).Value ' пробегаем по строкам первой таблицы (внутренний цикл) For i = 3 To last_i ' определяем идентификатор текущей строки str1 = sheet1.Cells(i, 1).Value & "-" & sheet1.Cells(i, 2).Value & "-" & sheet1.Cells(i, 3).Value & "-" & sheet1.Cells(i, 4).Value ' сравниваем идентификаторы строк первой и второй таблицы If str2 = str1 Then ' если совпадение найдено, то записываем покупателя из второй таблицы в первую в строку с соответствующей ему квартирой sheet1.Cells(i, 5).Value = sheet2.Cells(j, 5).Value ' прекращаем внутренний цикл, переходим к следующей итерации внешнего цикла ' (к следующей записи второй таблицы) Exit For End If Next i Next j End Sub |
