range.findall очень медленный.

Вот что я делаю с огромными данными на листе 1 и 2:

  1. сравните sheet1.columnnames (на основе множественных сравнений) со всеми соответствующими строками в листе2. Выделите различия и вставьте их в лист результатов.

  2. В листе результатов для всех строк, имеющих одинаковое значение в столбце1, проверьте цвет шрифта для других полей. если он красный, скопируйте столбец1 в новый лист результатов.

Я закончил с (1). Для (2) я использую функцию findall для диапазона от ( http://www.cpearson.com/excel/findall.aspx ), чтобы получить подмножество всех дубликатов в столбце1. Код работает, но он очень медленный. Есть ли другой способ, которым я могу это сделать?

Я мог бы сделать это с помощью массивов, но я не могу коснуться цветов шрифта с помощью массивов. Я попробовал Application.Calculation = xlCalculationManual и Application.ScreenUpdating = False. Это не имело никакого значения.

Ниже приведен фрагмент кода для поиска всех. Можете ли вы предложить любой другой метод?

Dim foundRange As Range Dim SearchRange As Range Dim FindWhat As Variant Dim irowcount, icount, iMaxCount As Long Dim bFlag As Boolean With XL_Ws_Result 'range with column header Set rowRangeHeaderA = .Range(.Cells(1, 1), .Cells(Last_Row_Base, Last_Col_Base)) 'range in result sheet without column header Set SearchRange = rowRangeHeaderA.Offset(1, 0).Resize(rowRangeHeaderA.Rows.count - 1, Last_Col_Base) End With For irowcount = 1 To SearchRange.Rows.count 'search string FindWhat = SearchRange.Cells(irowcount, 1) Set foundRange = FindAll(SearchRange:=SearchRange, _ FindWhat:=FindWhat, _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByColumns, _ MatchCase:=False, _ BeginsWith:=vbNullString, _ EndsWith:=vbNullString, _ BeginEndCompare:=vbTextCompare) If Not foundRange Is Nothing Then iMaxCount = foundRange.Rows.count For icount = 1 To iMaxCount 'check font color If foundRange.Cells(icount, 9).Font.ColorIndex = 3 And foundRange.Cells(icount, 9).Font.ColorIndex = 3 Then bFlag = True Else 'if any cell is not red i want to skip entire found range. not need for further processing bFlag = False Set foundRange = Nothing Exit For End If If bFlag = True Then XL_Mismatch.Cells(i, 1) = foundRange.Cells(1, 1).Value End If Next icount irowcount = irowcount + iMaxCount - 1 End If Next irowcount 

«для всех строк, которые имеют одинаковое значение в столбце1» -> это означает, что вы должны сделать .Autofilter (намного быстрее, чем .Find )

«проверьте цвет шрифта для других полей, если он краснеет, скопируйте столбец1 в новый лист результатов» -> затем вы .Autofilter отфильтрованные ячейки, как вы делали ИЛИ до или после предыдущего .Autofilter , вы добавляете столбец (скажем, 0 или 1) и проведите по ячейкам, чтобы получить цвет шрифта, как вы хотите, а затем. .Autofilter с двумя условиями на этот раз (значение + 0 или 1).

После этого не стесняйтесь копировать отфильтрованный диапазон и вставлять его в новый лист результатов.

Я думаю, что это должно быть быстрее.

Я изменил свою логику. Теперь я не использую findall . То, что я сделал,

1) sort file1. диапазон копирования в массив 1

2) сортировать файл2. скопируйте диапазон в массив2.

3) Я петлю через массив, чтобы найти общие строки и строки фильтров в соответствии с требуемыми критериями.

Его путь более быстрый и не требует дополнительных модулей.

Interesting Posts

Код Excel VBA вызывает сбои – Неизвестная причина

Проверьте, существует ли значение, если да, то скопируйте строку в другой лист VBA

MVC 4 Загрузка файла Excel в базу данных

Запись и сохранение документа Excel в IIS – ASP.NET MVC

VB.NET 64-битный COM с ссылочным классом сборки c #

В настоящее время нет операций для отображения

Как вы интегрируете ссылку на имя файла в формулу?

Apache POI – JAVA – повторение столбцов в excel

Как объединить формулу Excel с строкой относительного числа символов?

Combobox не заполняется, когда пользовательская форма инициализируется, но заполняется после закрытия и повторного открытия формы

Разверните таблицу с разделителями-запятыми в нескольких строках

У вас возникли проблемы с командой Dim и Set в VBA, скомпилируйте ошибку «несоответствие»,

есть ли способ для появления новых строк в excel на основе ответа на проверку данных?

Как переносить данные с помощью Excel

Обновление файла excel с использованием ODBC и PHP

Давайте будем гением компьютера.