Самый быстрый способ сравнить 2 листа Excel и разницу вывода с 3-м листом

У меня есть книга, которая загружает результаты SQL-запроса в два листа, которые называются «Старый» и «Новый». Затем конечный пользователь редактирует новый рабочий лист. Строки можно вставлять, удалять и изменять значения. В столбце M есть уникальный ключ. С помощью следующего кода я могу обнаруживать изменения между старым и новым, добавления и удаления, но он медленный и может занять 10+ минут при просмотре 5000+ строк. Буду признателен за любой совет по ускорению этого процесса.

Sub Compare()
Dim OldArray as Variant
Dim NewArray as Variant

'Load List objects into arrays.
OldArray = Old.DataBodyRange
NewArray = New.DataBodyRange

For i = LBound(OldArray) to UBound(OldArray)
OldValueToFind = OldArray(i,IDColumn) 'Find the ID value in the i row.

With Sheets("New").Range("M:M") 'ID Column
Set NewRng = .Find(What:=OldValueToFind,  _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=True)
If Not NewRng Is Nothing Then 'Found OldValue in New Worksheet
NewRowIndex = NewRng.Row - 1 'Remove header column

  For j = LBound(OldArray, 2) to UBound(OldArray, 2) 'For each column in Old

        If j <> 2 and j <> 9 and j <> 10 and j <> 11 and j < 14 Then 'We don't care about comparing these value. There has to be a better way to discard these.
          If OldArray(i,j) <> NewArray(NewRowIndex, j) Then
          'Add new row to 3rd worksheet with differences
          End If
        End If
  Next
Else
  'Add new row to 3rd worksheet as this record has been deleted
End If
End With
Next
'End of checking for deletions and changes
'Now to repeat for NewArray to find any additional rows added.
For i = LBound(NewArray) to UBound(NewArray)
  NewRowValue = NewArray(i, IDColumn) 'Get ID Value from New Worksheet
  With Sheets("Old").Range("M:M")
    Set viewRng = .Find(What:=NewRowValue, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=True)
    If viewRng Is Nothing Then 'Must be additional row as not found
    'Add new row to 3rd worksheet with all required columns.
    End If
  End With
Next
End Sub
    
```

0

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *