Зацикливание с использованием отфильтрованных строк и сравнение двух рабочих книг

Question

Приведенный ниже код работает нормально для нефильтрованных данных, и первая рабочая книга содержит от 100 до 8000 строк, а вторая рабочая книга содержит от 500 до 28000 строк.Я пытаюсь сравнить обе книги и обновить значения до Workbook2.Код ищет подходящие значения для каждой строки, и для его выполнения потребовалось много времени, даже если он работал в течение дня.8000 x 28000 позиций.

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

2. для каждого имени в последнем столбце (который является уникальным значением), отфильтруйте рабочую книгу1 и отфильтруйте рабочую книгу2, сравните каждую строку и обновите значения.На данный момент мы выполняем vlookup данных между двумя рабочими книгами и копируем и вставляем данные, которые совпадают, что не является непрерывным.так как есть ограничение не сортировать рабочую книгу2.Обязательно сортирую рабочую книгу1 по столбцу диспетчера отчетов.

   Public Function UpdateData(sFile1 As String, sFile2 As String) As Boolean
   Dim col1 As Integer
   Dim iCol, iname, ipos, idate, iUsername, iPSId, iUserid, iHint As Integer
   Dim iRUCost, iService As Integer
   Dim sName As String
   Dim sPos As String
   Dim sDate As String
   iPSId = Sheet1.Range("SAPID1").Value
   iRUCost = Sheet1.Range("rucost").Value
   iService = Sheet1.Range("service").Value
   col1 = Sheet1.Range("access1").Value
   iname = Sheet1.Range("name1").Value
   ipos = Sheet1.Range("position1").Value
   idate = Sheet1.Range("date1").Value
   iHint = Sheet1.Range("hint1").Value
   iUsername = Sheet1.Range("username1").Value
   iUserid = Sheet1.Range("userid1").Value
   
   Set objCWk1 = Application.Workbooks.Open(sFile1)
   Set objCWk2 = Application.Workbooks.Open(sFile2)
   
   iHeaderRow = Sheet1.Range("header1").Value
   
   For i = 1 To objCWk1.ActiveSheet.Cells(1, 1).End(xlDown).Row
   
   For j = iHeaderRow To objCWk2.ActiveSheet.Cells(iHeaderRow, 1).End(xlDown).Row
   'If iRUCost > 0 And iService > 0 Then
       If UCase(objCWk1.ActiveSheet.Cells(i, iUsername).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUsername).Value) And _
                                                   UCase(objCWk1.ActiveSheet.Cells(i, iUserid).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUserid).Value) And _
                                                   UCase(objCWk1.ActiveSheet.Cells(i, iRUCost).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iRUCost).Value) And _
                                                    UCase(objCWk1.ActiveSheet.Cells(i, iPSId).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iPSId).Value) And _
                                                   UCase(objCWk1.ActiveSheet.Cells(i, iService).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iService).Value) Then
   
           GoTo Action
   
       End If
       ElseIf iRUCost > 0 And iService = 0 Then
       If UCase(objCWk1.ActiveSheet.Cells(i, iUsername).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUsername).Value) And _
                                                   UCase(objCWk1.ActiveSheet.Cells(i, iUserid).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUserid).Value) And _
                                                   UCase(objCWk1.ActiveSheet.Cells(i, iPSId).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iPSId).Value) And _
                                                   UCase(objCWk1.ActiveSheet.Cells(i, iRUCost).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iRUCost).Value) Then
   
           GoTo Action
   
       End If
       ElseIf iRUCost = 0 And iService > 0 Then
       If UCase(objCWk1.ActiveSheet.Cells(i, iUsername).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUsername).Value) And _
                                                   UCase(objCWk1.ActiveSheet.Cells(i, iUserid).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUserid).Value) And _
                                                   UCase(objCWk1.ActiveSheet.Cells(i, iPSId).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iPSId).Value) And _
                                                   UCase(objCWk1.ActiveSheet.Cells(i, iService).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iService).Value) Then
   
           GoTo Action
   
       End If
       ElseIf iRUCost = 0 And iService = 0 Then
       If UCase(objCWk1.ActiveSheet.Cells(i, iUsername).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUsername).Value) And _
                                                   UCase(objCWk1.ActiveSheet.Cells(i, iPSId).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iPSId).Value) And _
                                                   UCase(objCWk1.ActiveSheet.Cells(i, iUserid).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUserid).Value) Then
   
           GoTo Action
   
       End If
       End If
       GoTo ThisAction
       Action:
       objCWk2.ActiveSheet.Cells(j, col1).Value = objCWk1.ActiveSheet.Cells(i, col1).Value
           objCWk2.ActiveSheet.Cells(j, col1 + 1).Value = objCWk1.ActiveSheet.Cells(i, col1 + 1).Value
           objCWk2.ActiveSheet.Cells(j, col1 + 2).Value = objCWk1.ActiveSheet.Cells(i, col1 + 2).Value
   
           objCWk2.ActiveSheet.Cells(j, iname).Value = objCWk1.ActiveSheet.Cells(i, iname).Value
           objCWk2.ActiveSheet.Cells(j, ipos).Value = objCWk1.ActiveSheet.Cells(i, ipos).Value
           objCWk2.ActiveSheet.Cells(j, idate).Value = objCWk1.ActiveSheet.Cells(i, idate).Value
           objCWk2.ActiveSheet.Cells(j, iHint).Value = objCWk1.ActiveSheet.Cells(i, iHint).Value
       ThisAction:
       Next j
       Next i
       objCWk2.Save
       objCWk1.Close
       objCWk2.Close
       Set objCWk1 = Nothing
       Set objCWk2 = Nothing
   
   End Function