VBA Loop с большим количеством результатов

Question

Мне нужно сравнить 2 файла xlsx.Оба выглядят одинаково.Файл 1 будет обновляться каждый день.

Теперь сценарий должен сравнивать каждый идентификатор (отдельные номера) в столбце 5, если он также находится в файле 2, столбце 5.Если да, текст из столбца 4 файла 1 (та же строка) должен быть обновлен в файле 2. Если идентификационный номер еще не указан в файле 2, то полную строку следует скопировать в первую свободную строку в конце файла 2.

Вот что у меня уже есть:

On Error Resume Next
   Set wkb = Workbooks.Open(Filename:=my_FileName)
   Set wkb1 = ThisWorkbook
   wkb1.Activate
   Set wks = wkb.Worksheets(1)
   Set wks1 = wkb1.Worksheets(1)
   anz = wks.Cells(65536, 5).End(xlUp).Row
   anz1 = wks1.Cells(65536, 5).End(xlUp).Row
   For Z = 2 To anz1
    suchwert = wks1.Cells(Z, 5)
    With wks.Range("E2:E" & anz)
    Set c = .Find(suchwert, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        For s = 4 To 5
            wks.Cells(c.Row, s) = wks1.Cells(Z, s)
            Next
        Else
        For s = 1 To 9
            wks.Cells(anz + 1, s) = wks1.Cells(Z, s)
            Next
    End If
    End With
   Next Z

Работает нормально для 1 результата.Но в файле 1 содержится более 700 идентификаторов.

Есть идеи?

Большое спасибо за вашу помощь!

С уважением, Крис

Answer 1

Может быть, вы можете попробовать это

On Error Resume Next
   Set wkb = Workbooks.Open(Filename:=my_FileName)
   Set wkb1 = ThisWorkbook
   wkb1.Activate
   Set wks = wkb.Worksheets(1)
   Set wks1 = wkb1.Worksheets(1)
   anz = wks.Cells(65536, 5).End(xlUp).Row
   anz1 = wks1.Cells(65536, 5).End(xlUp).Row
   Cpt = anz 

      For Z = 2 To anz1
       suchwert = wks1.Cells(Z, 5)
       With wks.Range("E2:E" & anz)
       Set c = .Find(suchwert, LookIn:=xlValues, LookAt:=xlWhole)
       If Not c Is Nothing Then

           For s = 4 To 5
               wks.Cells(c.Row, s) = wks1.Cells(Z, s)
               Next
           Else
           For s = 1 To 9
               Cpt = Cpt +1
               wks.Cells(Cpt, s) = wks1.Cells(Z, s)
               Next
       End If
       End With
      Next Z