我在Excel中运行此vba代码，它从工作表1复制一列，将其粘贴到第二页。然后在删除任何重复项之前将其与第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行需要比较，所以我知道它总是需要一些时间，但我想知道是否有任何方法可以加速它甚至只是让我的代码更加流线型和高效
答案 0 :(得分：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
答案 1 :(得分：2)
不要将工作表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中的值并检查字典中是否存在每个值。如果存在，请从字典中删除该项目。
答案 2 :(得分：0)
这是我的优化代码版本。
关于所使用概念的评论放在代码中。
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