优化VBA / Excelmacros代码（查找重复和sorting大型数据集）
我目前有一个代码被写入查找重复值从范围“A3”到最后一行使用; 突出显示重复的红色，包括第一个和最后一个实例; 按颜色突出显示，最后从最小到最大sorting。
稍后我将使用这些副本来复制到另一张表。 数据从列“A3”到“V3”开始，到最后一行使用。 数据范围从10,000到40,000行，可能更多取决于收到的数据。
我的问题是这个marco运行速度非常慢，有时会冻结..有没有另一种方法来达到相同的结果，但更有效和更快？
Sub filtersort () Dim sht As Worksheet Set sht = Worksheets("Sheet1") Lastrow = Range("A" & Rows.Count).End(xlUp).Row N = Cells(Rows.Count, "A").End(xlUp).Row sht.Range("A3:A" & Lastrow).Select Selection.FormatConditions.AddUniqueValues Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).DupeUnique = xlDuplicate With Selection.FormatConditions(1).Font .Color = -16383844 .TintAndShade = 0 End With With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 13551615 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False sht.Range("A3:A" & Lastrow).Select Application.CutCopyMode = False Selection.AutoFilter ActiveSheet.Range("$A$3:$A$" & Lastrow).AutoFilter Field:=1, Criteria1:=RGB(255, _ 199, 206), Operator:=xlFilterCellColor sht.Range("A3:V" & N).Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlYes End Sub 自动filter负责运行缓慢的代码。 唯一项目的数量都会影响代码的速度。
如果你的意图是检索sorting的重复数据，你可以尝试这种方法。
下面给出的代码将添加一个名为“重复数据”的新表，并包含所有重复数据并将其sorting在A列上。
代码假定数据位于名为Sheet1的工作表上，row3是标题行，实际数据是从row4开始的。
如果需要修改它。
Sub filtersort() Dim wsData As Worksheet, wsOutput As Worksheet Dim Rng As Range Dim LastRow As Long, LastCol As Long, i As Long, j As Long, n As Long Dim arr(), x, dict, arrOut() With Application .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False End With Set wsData = Worksheets("Sheet1") On Error Resume Next Set wsOutput = Sheets("Duplicate Data") wsOutput.Cells.Clear On Error GoTo 0 If wsOutput Is Nothing Then Sheets.Add(after:=wsData).Name = "Duplicate Data" Set wsOutput = ActiveSheet End If LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row LastCol = wsData.Cells(3, Columns.Count).End(xlToLeft).Column + 1 Set Rng = wsData.Range("A3:A" & LastRow) x = wsData.Range("A4:V" & LastRow).Value Set dict = CreateObject("Scripting.Dictionary") For i = 1 To UBound(x, 1) If Not dict.exists(x(i, 1)) Then dict.Item(x(i, 1)) = "" Else j = j + 1 ReDim Preserve arr(1 To j) arr(j) = x(i, 1) End If Next i ReDim arrOut(1 To UBound(x, 1), 1 To UBound(x, 2)) For i = 1 To UBound(x, 1) If Not IsError(Application.Match(x(i, 1), arr, 0)) Then n = n + 1 For j = 1 To UBound(x, 2) arrOut(n, j) = x(i, j) Next j End If Next i wsData.Range("A3:V3").Copy wsOutput.Range("A3") wsOutput.Range("A4").Resize(n, UBound(x, 2)).Value = arrOut LastRow = wsOutput.Cells(Rows.Count, 1).End(xlUp).Row wsOutput.Range("A3:V" & LastRow).Sort Key1:=wsOutput.Range("A4"), Order1:=xlDescending, Header:=xlYes With Application .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True End With End Sub
您可以使用数据透视表带来项目的计数，只是从空白和1计数项目删除filter，这里是您的重复值列表。 您可以使用VBA自动执行此过程。
在表单的最后一列写入一个公式，该公式将返回logging的RowNumber。 意思是第一次findlogging就返回1.第二次返回2，第三次3等
一旦你有这个公式正确，你可以在vba自动化这个部分。
现在按这一列对数据进行sorting。
批量剪切并粘贴，其中rowNumber> 1。 很多时候，我看到类似的东西，人们在vba中逐行处理它。 在工作簿中使用公式要慢很多。 分类和切割。