Ускорить макрос для больших файлов (более 90000 строк, 236 столбцов)

Question

Я написал макрос, который сравнивает столбцы B, который содержит номера файлов, в двух листах. Существует три возможности: номер файла существует в обоих столбцах, номер файла существует только в первом столбце, а номер файла существует только во втором столбце. Если, например, номер файла существует в обоих столбцах, макрос должен скопировать/вставить всю строку на другой лист. То же самое для двух других сценариев.

Мой код отлично подходит для небольшого файла (около 500 строк, 236 столбцов), но для больших файлов он не работает. Это занимает слишком много времени, и в конце он просто падает. Я уже пробовал обычные трюки, чтобы ускорить макрос.

Option Explicit 

Sub CopyPasteWorksheets() 

Dim wbDec As Workbook, wbJune As Workbook, wbAnalysis As Workbook 
Dim wsDec As Worksheet, wsJune As Worksheet 
Dim PresPres As Worksheet, PresAbs As Worksheet, AbsPres As Worksheet 

'Stop screen from updating to speed things up 
Application.ScreenUpdating = False 
Application.EnableEvents = False 

'Add 3 new worksheets. They each represent a different category, namely the one with already existing insurances, one with new insurances 
'and one with the insurances that are closed due to mortality, lapse or maturity. Add two (temporary) worksheets to paste the databases. 

Worksheets.Add().Name = "PresPres" 
Worksheets.Add().Name = "PresAbs" 
Worksheets.Add().Name = "AbsPres" 
Worksheets.Add().Name = "DataDec" 
Worksheets.Add().Name = "DataJune" 

'Define the active workbook 

Set wbAnalysis = ThisWorkbook 

'Define the first database. Copy/paste the sheet and close them afterwards. 

Set wbDec = Workbooks.Open(Filename:="F:\Risk_Management_2\Embedded_Value\2015\20151231\Data\DLL\Master Scala\Extract.xlsx") 

wbDec.Sheets("SCALA").Range("A1").CurrentRegion.Copy 
wbAnalysis.Sheets("DataDec").Range("A1").PasteSpecial xlPasteValues 

wbDec.Close 

'We have to do the same for the other database. We cannot do it at the same time, because both files have the same name, 
'and can't be opened at the same time. 

Set wbJune = Workbooks.Open(Filename:="F:\Risk_Management_2\Embedded_Value\2016\20160630\Data\DLL\Master Scala\extract.xlsx") 

wbJune.Sheets("SCALA").Range("A1").CurrentRegion.Copy 
wbAnalysis.Sheets("DataJune").Range("A1").PasteSpecial xlPasteValues 

wbJune.Close 

Application.ScreenUpdating = True 
Application.EnableEvents = True 

End Sub 

Sub Compare() 

Dim DataDec As Worksheet, DataJune As Worksheet 
Dim lastRowDec As Long 
Dim lastRowJune As Long 
Dim lastRowPresAbs As Long 
Dim lastRowPresPres As Long 
Dim lastRowAbsPres As Long 
Dim foundTrue As Boolean 
Dim i As Long, j As Long, k As Long, l As Long 

'Define the last row of the different sheets 
lastRowDec = Sheets("DataDec").Cells(Sheets("DataDec").Rows.Count, "B").End(xlUp).Row 
lastRowJune = Sheets("DataJune").Cells(Sheets ("DataJune").Rows.Count, "B").End(xlUp).Row 
lastRowPresAbs = Sheets("PresAbs").Cells(Sheets("PresAbs").Rows.Count, "B").End(xlUp).Row 
lastRowPresPres = Sheets("PresPres").Cells(Sheets ("PresPres").Rows.Count, "B").End(xlUp).Row 
lastRowAbsPres = Sheets("AbsPres").Cells(Sheets("AbsPres").Rows.Count, "B").End(xlUp).Row 

'Compare the file numbers in column B of both sheets. If they are the same, copy/paste the entire row to sheet PresPres, 
'if they are not, copy/paste the entire row to sheet PresAbs. 

For i = 1 To lastRowDec 
foundTrue = False 
For j = 1 To lastRowJune 

If Sheets("DataDec").Cells(i, 1).Value = Sheets("DataJune").Cells(j, 1).Value Then 
    foundTrue = True 
    Sheets("PresPres").Rows(lastRowPresPres + 1) = Sheets("DataDec").Rows(i) 
    lastRowPresPres = lastRowPresPres + 1 
    Exit For 
End If 

Next j 

If Not foundTrue Then 
Sheets("DataDec").Rows(i).Copy Destination:= _ 
Sheets("PresAbs").Rows(lastRowPresAbs + 1) 
lastRowPresAbs = lastRowPresAbs + 1 

End If 

Next i 


'Look if there are file numbers that are only present in June's database. If so, copy/paste entire row to sheet AbsPres. 
For k = 1 To lastRowJune 
foundTrue = False 
For l = 1 To lastRowDec 

If Sheets("DataJune").Cells(k, 1).Value = Sheets("DataDec").Cells(l,  1).Value Then 
    foundTrue = True 
    Exit For 
End If 

Next l 

If Not foundTrue Then 
Sheets("DataJune").Rows(k).Copy Destination:= _ 
Sheets("AbsPres").Rows(lastRowAbsPres + 1) 
lastRowAbsPres = lastRowAbsPres + 1 

End If 

Next k 

'Stop screen from updating to speed things up. 
Application.ScreenUpdating = True 
Application.EnableEvents = True 

End Sub 

Я добавил несколько комментариев, чтобы объяснить, что я пытаюсь сделать. Я относительно новичок в VBA, поэтому считаю, что я не очень эффективен в кодировании.

Может ли кто-нибудь взглянуть и попытаться заставить его работать?

Answer 1

В принципе, что делает это сравнение 2 столбца элементов, вы хотите знать, когда:

1. элемент находится в обеих столбцах
2. элемент находится только в первой колонке
3. элемент только во второй колонке

Чтобы сделать это, ваше решение сделать:

1. Для каждого элемента в столбце 1,
2. Найти, если есть этот элемент в колонке 2
3. Если обнаружено, что в обоих, если нет, то это только в 1
4. Перейти к следующему элементу в столбце 1
5. ли совсем то же самое с элементом колонны 2

Так в основном, ваш следственным столбец 2 для каждого элемента столбца 1 И то же самое для столбца 1 с элементом колонны 2

если мы рассматриваем n длины столбца 1 и m длины столбца2. То есть примерно 2 * m * n сравнение. Это очень много!

Мое решение: Вы ищете для чисел в столбце B. Поэтому можно сортировать как лист базы по значению в колонке B

Тогда вы можете:

1. Создать COUNTER1 и counter2, ссылаясь на текущий ряд в листах1 и в листе2
2. Сравните значение sheet1.Value ('B' + counter1) с листом2.Value ('B' + counter2)
3. Тогда у вас есть 3 варианта: a) Это то же самое значение, затем скопируйте строку в правый файл и увеличивайте оба счетчика . B) Значение из листа1 больше, тогда вы никогда не найдете значение из листа2 в листе1.Поэтому скопируйте строку листа2 в правый файл и увеличьте только счетчик2 c) Противоположный
4. Сделайте это до тех пор, пока счетчик 1 или счетчик2 не окажется в конце.
5. Как нельзя возможно, что оба не будут в конце одновременно, вам придется скопировать оставшиеся строки в нужном файле, поскольку они никогда не будут находиться в «готовом» листе.

С помощью этого решения вы будете читать только каждую «колонку» один раз! Так примерно о т + п сравнения :) Вы выиграете много времени :)

С М = п = 90 000:

• у вас есть раствор с т * п = 8 100 000 000 Сравнение
• другое решение только о 180 000 сравнения

Answer 2

Это должно быть самым быстрым подход, как копирование всех данных сразу же происходит гораздо быстрее, чем копирование его по строкам.

Выберите обе колонки> Главная вкладка> Условное форматирование> Выделение клеток Правила> Повторяющиеся значения ...

Теперь вам нужен фильтр из Data>Filter, но для этого вам нужно будет вставить строку заголовка над номера. После того, как у вас есть фильтр, вы можете щелкнуть по фильтру второго столбца и по фильтру по цвету. Теперь вы можете скопировать видимые ячейки туда, где вы копируете дубликаты. Я рекомендую сортировать по цвету перед копированием, так как копирование одной смежной области должно быть немного быстрее.

Вы можете использовать тот же метод для двух других случаев, фильтруя столбцы с помощью Filter by Color> No Fill.

Перед записью Макро процесса можно выбрать вкладку Вид> Макросы> Использовать относительные ссылки.

Редактировать

Я думаю, что я неправильно понял вопрос. Этот метод требует, чтобы оба столбца находились рядом друг с другом, поэтому, если они находятся на отдельных листах, вы можете скопировать их и вставить в столбец A. Вы можете скрыть столбец после применения фильтра. Затем вы можете удалить строки столбца и заголовка, если это необходимо.

Аналогичный подход без условного форматирования заключается в вставке столбца со вспомогательной функцией, которая проверяет, существует ли идентификатор на другом листе, но я думаю, что это будет немного медленнее. Например:

= CountIf(Sheet2!A1:A1234, B2) 

Answer 3

я получил ответ на свой вопрос на форуме г-н Excel:

http://www.mrexcel.com/forum/excel-questions/963415-visual-basic-applications-speed-up-macro-large-file.html

Спасибо за ваши ответы!