使VBA-Excel代码更高效

我在Excel中运行这个vba代码，它复制了表1中的一列，将其粘贴到表二中。 然后在删除任何重复项之前，将它与表二中的一列进行比较。

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使用的代价高昂的部分，限制访问工作表多less次以获得更快的代码。 你也可以尝试删除循环读取条目，并尝试在一行代码中做到这一点

慢的部分要考虑

 .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