使VBA

使VBA-Excel代码更高效(Making VBA-Excel code more Efficient)

我在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行，所以我知道它总是需要一些时间，但我想知道是否有任何方法可以加快速度，甚至只是让我的代码更加流线型和高效。

I am running this vba code in Excel, it copies a columns from sheet 1, pastes it into sheet two. It then compares it to a column in sheet two before deleting any duplicates.

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

There is just under 30,000 rows that it has to compare so I know that it is always going to take some time, but I was wondering if there was any way to speed it up or even just make my code more streamline and efficient.

最满意答案

不要从工作表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中的值，并检查它们中是否存在每个值。 如果存在，请从字典中删除该项。

Don't copy and paste from sheet 1 to sheet 2. Store the values from both sheets in arrays:

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

Then read the values in v1 into a dictionary, loop through the values in v2 and check if each of them exists in the dictionary or not. If they exist, remove the item from the dictionary.