如何在 VBA 中高效地创建多个 "for" 语句运行

Question

在我的代码中有一个搜索顺序，它的作用如下：

它获取 ws.sheet 范围 A 中的每个值（大约 2000 个范围）并在另一个 sheet 名为 wp.sheet 范围 A（大约 90 个范围）中查找它。如果 ws.sheet 范围内的特定值 x 例如 A3 在 wp.sheet 范围 A 中找不到，则 sheet ws.sheet 中的下一个搜索顺序是下一个范围 B3 中的值 y (与值 x) 在 sheet wp.sheet 中在整个范围 B 中搜索的同一行，依此类推。

这就是我的 "for" 循环所做的，我的代码的问题是它需要很长时间才能将 ws.sheet 范围 A1-2000 中的每个值与 [=22] 中的值进行比较=] 范围 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

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

Answer 2

我建议关闭 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

如何在 VBA 中高效地创建多个 "for" 语句运行

How to make multiple "for" statements run efficiently in VBA

vba

for-loop

row

next

如何在 VBA 中高效地创建多个 "for" 语句 运行

How to make multiple "for" statements run efficiently in VBA

vba

for-loop

row

next

如何在 VBA 中高效地创建多个 "for" 语句运行