range.findall очень slow.any альтернативы

Question

Вот что я делаю с огромными данными в листе 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 

Answer 1

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

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

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

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

Answer 2

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

1) сортировать файл1. диапазон копирования в массив 1

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

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

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