Выбрать дату в календареВыбрать дату в календаре

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



Для начала напишем алгоритм наших действий по сравнению таблиц.
  1. Определим диапазоны данных первой и второй таблицы, то есть найдем последние значимые строки и сохраним их номера в переменных (последняя строка таблицы 1 - last_i и последняя строка таблицы 2 - last_j).
  2. Начнем проходить по каждой строке таблицы 2 (внешний цикл), данные из которой нужно перенести в таблицу 1. С первой строки данных (в примере это строка 3) до последней строки таблицы 2.
  3. Для каждой строки таблицы 2 определим идентификатор строки, путем формирования строки, содержащей полный адрес квартиры (значения из нескольких колонок, разделенные дефисами).
  4. Начнем проходить по каждой строке таблицы 1 (внутренний цикл) с первой строки данных (в примере это строка 3) до последней строки таблицы 1, определяя при этом идентификатор строки.
  5. Сравним значения идентификаторов строк таблицы 1 и таблицы 2.
  6. Если идентификаторы равны, перепишем ФИО покупателя из ячейки таблицы 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
Результат решения задачи:
Удаление отфильтрованного диапазона по цвету, Удаление тех строк которые не отсортированы по цвету
 
Помогите пожалуйста написать макрос. в котором будут удаляться все строки отфильтрованного диапазона. У меня есть вся  группа техники в гараже, та которая выезжает на линю гос номер окрашивается желтым цветом, в конце месяца нужны только те строки где гос номер окрашен цветом чтоб проводить анализ лишние строки надо удалить( отсортировать не походит, т.к. формула дальше очень долго обрабатывает все строки)  Пробовал в цикле удалять те строки что не желтые это тоже очень долго выполняется макрос(около 30мин, так.как файл сильно большой)
Изменено: hohel - 23.11.2015 15:29:42
Страницы: 1
Наверх