VBA/Excelマクロコードの最適化（重複データの検索と大きなデータセットのソート）

Question

現在、範囲 "A3"から重複した値が最後の行まで検索されるように書かれたコードがあります。最初のインスタンスと最後のインスタンスの両方を赤色で強調表示します。色を強調表示し、最後に最小から最大まで並べ替えます。

これらの複製を後で使用して別のシートにコピーします。データは列「A3」から「V3」および最後に使用された行から始まります。データは、10,000〜40,000行のどこかの範囲にあります。おそらく受信したデータによります。

私の問題は、このマルコが非常に遅く走り、時には凍結するということです。同じ結果を達成するための別の方法がありますが、より効率的かつ迅速です。

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 

Answer 1

オートフィルタは、実行速度の遅いコードの原因です。ユニークなアイテムの数はすべてコードの速度に影響します。

ソートされた重複データを取得する場合は、この方法を試してみてください。

下記のコードは、コードをすべての重複データを「重複データ」と呼ばれる新しいシートを追加して、列Aに

それをソートしますROW3がされ、データがシート1と呼ばれるシート上にあることを前提としてい実際のデータは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 

Answer 2

あなたはアイテムのカウントを持参し、ちょうど空白と1カウント項目からフィルタを削除し、ここに重複する値のリストがあるためにピボットテーブルを使用することができます。このプロセスは、VBAを使用して自動化できます。

Answer 3

レコードのRowNumberを返すシートの最後の列に数式を書き込みます。最初にレコードが見つかったときは、1を返します。2回目、2回目、3回目などを返します。

この式が正しいと、vbaでこの部分を自動化できます。

この列でデータを並べ替えることができます。

rowNumber> 1の場合、バルクでカットアンドペーストします。何度も、人々がvbaでそれを1行ずつ処理する類似のものが見られます。ワークブックの数式を使った方がずっと遅いです。ソートとカット。