Блог

В моем коде есть порядок поиска, и он выполняется следующим образом:

Он принимает каждое значение (около 2000 диапазонов) в ws.sheet range A и просматривает его на другом листе с именем wp.sheet range A (около 90 диапазонов). Если определенное значение x в диапазоне ws.sheet, например A3, не найдено в диапазоне wp.sheet A, следующий порядок поиска на листе ws.sheet — это значение y в следующем диапазоне B3 (та же строка, что и значение x), которое будет найдено на листе wp.sheet во всем диапазоне B, и так далее.

Это то, что делает мой цикл «for», и проблема с моим кодом заключается в том, что сравнение каждого значения в диапазоне ws.sheet A1-2000 со значениями в диапазоне wp.sheet A1-90 занимает очень много времени. Есть ли альтернатива, которая делает это быстрее или эффективнее?

 Dim wb As Workbook, wq As Object
Dim ws, wi As Worksheet, datDatum
Dim w As Long, I As Long, t As Long
Dim DefaultMsgBox()
Dim r, i As Integer    



For r = 2 To 2000

Check = True:

For i = 1 To 90
    If ws.Range("A" amp; r).Value = wp.Sheets("ABC").Range("A" amp; i).Value Then
       wp.Sheets("ABC").Rows(i).Columns("E:AB").Copy
       ws.Range("G" amp; r).PasteSpecial
       GoTo NextR
    End If
Next i

For i = 1 To 90
     If ws.Range("B" amp; r).Value = wp.Sheets("ABC").Range("B" amp; i).Value Then
        wp.Sheets("ABC").Rows(i).Columns("E:AB").Copy
        ws.Range("G" amp; r).PasteSpecial
        GoTo NextR
     End If
Next i

For i = 1 To 90
     If ws.Range("C" amp; r).Value = wp.Sheets("ABC").Range("C" amp; i).Value And ws.Range("D" amp; r).Value = wp.Sheets("ABC").Range("D" amp; i).Value Then
        wp.Sheets("ABC").Rows(i).Columns("E:AB").Copy
        ws.Range("G" amp; r).PasteSpecial
        GoTo NextR
     End If
 Next i

NextR:
    If Not Check = ws.Range("A" amp; r).Value = wp.Sheets("ABC").Range("A" amp; i).Value Or Not Check = ws.Range("B" amp; r).Value = wp.Sheets("ABC").Range("A" amp; i).Value Or Not Check = ws.Range("C" amp; r).Value = wp.Sheets("ABC").Range("C" amp; i).Value And ws.Range("D" amp; r).Value = wp.Sheets("ABC").Range("D" amp; i).Value Then
    MsgBox "......"
    End If
Next r
End sub
  

Я бы предложил отключить обновление экрана и вместо этого использовать функцию Find:

 Dim cell, foundValue, lookupRange As Range

Set wp = ThisWorkbook.Sheets("ABC")
Set ws = ThisWorkbook.Sheets("WS")

r = 2
number_r = 2000
ru = 1
number_ru = 90

Application.ScreenUpdating = False

'Loop through each cell in WS, offsetting through columns A to C
For Each cell In ws.Range("A" amp; r amp; ":A" amp; number_r)
    For i = 0 To 2

        'Define range to look up in ABC
        Set lookupRange = wp.Range(wp.Cells(ru, i   1), wp.Cells(number_ru, i   1))

        'Look for current WS cell on corresponding column in ABC
        Set foundValue = lookupRange.Find(cell.Offset(0, i).Value)

        'If cell is found in ABC...
        If Not foundValue Is Nothing Then
            Select Case i
            Case 2 'If found cell is in column C

                Do 'Lookup loop start

                'If same values on columns D...
                If foundValue.Offset(0, 1).Value = cell.Offset(0, 3).Value Then

                    'Copy data to WS and switch to the next cell
                    wp.Rows(foundValue.Row).Columns("E:AB").Copy
                    ws.Range("G" amp; cell.Row).PasteSpecial
                    GoTo nextCell

                'If not same values on columns D...
                Else

                    'Try to find next match, if any
                    Set foundValue = lookupRange.FindNext(foundValue)
                    If foundValue Is Nothing Then GoTo noMatchFound

                End If

                Loop 'Repeat until WS values in column C and D match ABC values in columns C and D

            Case Else 'If found cell is in column A or B

                'Copy data to WS and switch to the next cell
                wp.Rows(foundValue.Row).Columns("E:AB").Copy
                ws.Range("G" amp; cell.Row).PasteSpecial
                GoTo nextCell

            End Select

        End If
    Next i
noMatchFound:
    MsgBox "......" 'Message appears only when no match was found in column A, column B and column C   D
nextCell:
Next cell

Application.ScreenUpdating = True
  

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