Question

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

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

这是我的“ 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语句，则将其注释掉，您的代码将运行得更快。

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

2 个答案: