使VBA-Excel代码更高效

Question

我在Excel中运行此vba代码，它从表1复制列，将其粘贴到表2中。然后将其与表2中的列进行比较，然后删除任何重复项。

Private Sub CommandButton1_Click()
Dim MasterList As New Dictionary
    Dim iListCount As Integer
    Dim x As Variant
    Dim iCtr As Integer
    Dim v As Variant
    Dim counter As Integer, i As Integer
    counter = 0
    Sheets("Sheet2").Select
    Sheets("Sheet2").Range("M:M").Select
    Selection.ClearContents
    Sheets("Sheet1").Select
    Sheets("Sheet1").Range("C:C").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Sheets("Sheet2").Range("M1").Select
    ActiveSheet.Paste
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    ' Get count of records in master list
    iListCount = Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row
    'Load Dictionary:
    For iCtr = 1 To iListCount
        v = Sheets("sheet2").Cells(iCtr, "A").value
        If Not MasterList.Exists(v) Then MasterList.Add v, ""
    Next iCtr
    'Get count of records in list to be deleted
    iListCount = Sheets("sheet2").Cells(Rows.Count, "M").End(xlUp).Row

    'Loop through the "delete" list.
    For iCtr = iListCount To 1 Step -1
        If MasterList.Exists(Sheets("Sheet2").Cells(iCtr, "M").value) Then
            Sheets("Sheet2").Cells(iCtr, "M").Delete shift:=xlUp
        End If
    Next iCtr

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Done!"
End Sub

只有不到30,000行，它必须比较，所以我知道它总是要花一些时间，但我想知道是否有任何方法来加快它，甚至只是使我的代码更精简和高效。

Answer 1

不要从工作表1复制粘贴到工作表2。将两个工作表中的值存储在数组中:

Dim v1 as variant, v2 as variant
v1 = Sheet1.Range("C:C").Value
v2 = Sheet2.Range("A1").Resize(iListCount,1).Value

然后将v1中的值读入字典，循环遍历v2中的值并检查它们是否存在于字典中。如果存在，则从字典中删除该条目。

Answer 2

这样会更有效率一些

Dim MasterList As New Dictionary
Dim iListCount As Integer
Dim x As Variant
Dim iCtr As Integer
Dim v As Variant
Dim counter As Integer, i As Integer
counter = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("Sheet2")
    .Range("M:M").ClearContents
    Sheets("Sheet1").Range("C:C").Copy
    .Range("M1").Paste
    ' Get count of records in master list
    iListCount = .Cells(Rows.Count, "A").End(xlUp).Row
    'Load Dictionary:
    For iCtr = 1 To iListCount
        v = .Cells(iCtr, "A").Value
        If Not MasterList.Exists(v) Then MasterList.Add v, ""
    Next iCtr
    'Get count of records in list to be deleted
    iListCount = .Cells(Rows.Count, "M").End(xlUp).Row
    ' Loop through the "delete" list.
    For iCtr = iListCount To 1 Step -1
        If MasterList.Exists(.Cells(iCtr, "M").Value) Then
            .Cells(iCtr, "M").Delete shift:=xlUp
        End If
    Next iCtr
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Done!"

如果你真的想让它更有效，我将修改

    ' Loop through the "delete" list.
    For iCtr = iListCount To 1 Step -1
        If MasterList.Exists(.Cells(iCtr, "M").Value) Then
            .Cells(iCtr, "M").Delete shift:=xlUp
        End If
    Next iCtr

所以你错过了这张表。例如，将它们从字典中删除，然后清除列表，然后在一行代码中输出字典。就CPU使用而言，访问工作表是代价高昂的部分，限制访问工作表的次数以获得更快的代码。你也可以试着删除读取条目的循环，并尝试在一行代码中完成

慢速部分要考虑

.Cells(iCtr, "A").Value

并可能导致

以下的大部分时间

.Cells(iCtr, "M").Delete shift:=xlUp

Answer 3

这是我的优化代码版本。

关于所使用概念的注释放在代码中。

Private Sub CommandButton1_Click()
    Dim MasterList As New Dictionary
    Dim data As Variant
    Dim dataSize As Long
    Dim lastRow As Long
    Dim row As Long
    Dim value As Variant
    Dim comparisonData As Variant
    Dim finalResult() As Variant
    Dim itemsAdded As Long
    '-----------------------------------------------------------------

    'First load data from column C of [Sheet1] into array (processing
    'data from array is much more faster than processing data
    'directly from worksheets).
    'Also, there is no point to paste the data to column M of Sheet2 right now
    'and then remove some of them. We will first remove unnecessary items
    'and then paste the final set of data into column M of [Sheet2].
    'It will reduce time because we can skip deleting rows and this operation
    'was the most time consuming in your original code.
    With Sheets("Sheet1")
        lastRow = .Range("C" & .Rows.Count).End(xlUp).row
        data = .Range("C1:C" & lastRow)
    End With

    'We can leave this but we don't gain much with it right now,
    'since all the operations will be calculated in VBA memory.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'We make the same operation to load data from column A of Sheet2
    'into another array - [comparisonData].
    'It can seem as wasting time - first load into array instead
    'of directly iterating through data, but in fact it will allow us
    'to save a lot of time - since iterating through array is much more
    'faster than through Excel range.
    With Sheets("Sheet2")
        lastRow = .Range("A" & .Rows.Count).End(xlUp).row
        comparisonData = .Range("A1:A" & lastRow)
    End With
    'Iterate through all the items in array [comparisonData] and load them
    'into dictionary.
    For row = LBound(comparisonData, 1) To UBound(comparisonData, 1)
        value = comparisonData(row, 1)
        If Not MasterList.Exists(value) Then
            Call MasterList.Add(value, "")
        End If
    Next row

    'Change the size of [finalResult] array to make the place for all items
    'assuming no data will be removed. It will save some time because we
    'won't need to redim array with each iteration.
    'Some items of this array will remain empty, but it doesn't matter
    'since we only want to paste it into worksheet.
    'We create 2-dimensional array to avoid transposing later and save
    'even some more time.
    dataSize = UBound(data, 1) - LBound(data, 1)
    ReDim finalResult(1 To dataSize, 1 To 1)

    'Now iterate through all the items in array [data] and compare them
    'to dictionary [MasterList]. All the items that are found in
    '[MasterDict] are added to finalResult array.
    For row = LBound(data, 1) To UBound(data, 1)
        value = data(row, 1)
        If MasterList.Exists(value) Then
            itemsAdded = itemsAdded + 1
            finalResult(itemsAdded, 1) = value
        End If
    Next row

    'Now the finalResult array is ready and we can print it into worksheet:
    Dim rng As Range
    With Sheets("Sheet2")
        Call .Range("M:M").ClearContents
        .Range("M1").Resize(dataSize, 1) = finalResult
    End With

    'Restore previous settings.
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "Done!"

End Sub