Question

我有一个列表，从一个工作表复制到＆＃34;计算＆＃34;工作表，以及从另一个工作表复制到同一＆＃34;计算＆＃34;片。在我的宏之前，我使用=VLOOKUP()公式来确定每个项目是否在另一个列表中匹配，反之亦然。现在我的代码逐项循环。

是否有更有效/省时的方法来获得相同的结果？（我有一个副本用于计数器比较 - 这是A＆gt; B，其他是B＆gt; A）

以下是代码：

Sub GPWireDifference()

'Establishes the Unmatched Great Plains Values list
    Set BWGPValues = New Dictionary


'Creates a variable to check if Keys already exist in list
    Dim lookup As String
    'Creates a variable to store the unmatched amount
    Dim amount As Currency
    'Sets a variable to count the amount of items in the checked list
    lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row


'Format all columns in the Calculation sheet to fit their contents
    Cells.EntireColumn.AutoFit
    'Formatting the numbers to the common "currency" type
    Range("B:E").NumberFormat = "$#,##0.00"
    Range("D2").Activate


'In the event of the value not matching, send the chain to a separate segment
    On Error GoTo ErrorHandler:


'Creates a loop to set the cell values to the results of the VLookup formula
    Do Until ActiveCell.Offset(0, -3).Value = ""
        ActiveCell.Value = Application.WorksheetFunction. _
            IfError(Application.WorksheetFunction. _
                VLookup(ActiveCell.Offset(0, -2), Range("C:C"), 1, False), 0)
        ActiveCell.Offset(1, 0).Activate
    Loop


'This error handler is to create a buffer so the macro doesn't lock itself into the
' error status... Unsure why, but if the buffer wasn't here, it breaks the code
ErrorHandler:
    If Not ActiveCell.Offset(0, -3).Value = "" Then
        GoTo ErrorHandler2:
    End If


'This error handler sets the Key and Item for the list, and stores the values
ErrorHandler2:
    If Not ActiveCell.Offset(0, -3).Value = "" Then
        lookup = ActiveCell.Offset(0, -3).Value
        amount = ActiveCell.Offset(0, -2).Value
        'Checks to see if the Key already exists. If so, sets the item value to the
        ' sum of the existing value and the new value
        If BWGPValues.Exists(lookup) Then
            BWGPValues(lookup) = BWGPValues(lookup) + amount
        Else 'If not, then it adds the key and the item values
            BWGPValues.Add lookup, amount
        End If
        Resume Next 'Returns to the loop
    End If


'Creates headers for the comparison rows
    Range("D1").Value = "GP to Wires:"
    Range("E1").Value = "Wires to GP:"


'Reformats the columns to fit all contents
    Cells.EntireColumn.AutoFit

End Sub

Answer 1

此：

Do Until ActiveCell.Offset(0, -3).Value = ""
    ActiveCell.Value = Application.WorksheetFunction. _
        IfError(Application.WorksheetFunction. _
            VLookup(ActiveCell.Offset(0, -2), Range("C:C"), 1, False), 0)
    ActiveCell.Offset(1, 0).Activate
Loop

会更好：

Dim c As Range, res
Set c = Range("D2")

Do Until c.Offset(0, -3).Value = ""
    res = Application.VLookup(c.Offset(0, -2), Range("C:C"), 1, False)
    'if no match then res will contain an error, so test for that...
    c.Value = IIf(IsError(res), 0, res)

    Set c = c.Offset(1, 0)
Loop

删除select / activate更快，如果Vlookup没有匹配，则删除WorksheetFunction可以防止触发运行时错误

Answer 2

我测试了3000个值的列表。不确定您是否已经使用它，但绝对应该使用Application.ScreenUpdating = False（对于我的测试用例，差异为2500毫秒到220毫秒）。除此之外，您还可以使用下面的代码进一步优化，它可以在大约20 ms内执行两次比较，从而节省大约420 ms或几乎1/2秒。

有没有更快的方式在我的列表中循环？

2 个答案: