如何使多个“for”语句在 VBA 中高效运行

Question

在我的代码中有一个搜索顺序，如下所示：

它获取 ws.sheet range A 中的每个值（大约 2000 个范围）并在另一个名为 wp.sheet range A 的工作表中查找它（大约 90 个范围）。如果 ws.sheet 范围中的特定值 x，例如 A3 在 wp.sheet 范围 A 中未找到，则工作表 ws.sheet 中的下一个搜索顺序是要搜索的下一个范围 B3（与值 x 相同的行）中的值 y表 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" & r).Value = wp.Sheets("ABC").Range("A" & i).Value Then
       wp.Sheets("ABC").Rows(i).Columns("E:AB").Copy
       ws.Range("G" & r).PasteSpecial
       GoTo NextR
    End If
Next i

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

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

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

Answer 1

我建议关闭 ScreenUpdating 并改用 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" & r & ":A" & 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" & 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" & 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

Answer 2

我希望你不介意我这么说，但是你的代码很难理解，包括你选择的变量名。我可以建议，如果您不使用 .copy 语句，请将它们注释掉，您的代码会运行得更快。