我在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 SubThere 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).ValueThen 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.
更多推荐
发布评论