【VBA】重複データを高速に配列に格納する方法

Option Explicit
Sub DuplicateDataToArray()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    Application.ScreenUpdating = False '画面更新停止
    
    Dim lastRow As Long, i As Long, j As Long
    Dim dataRange As Range
    Dim arrData() As Variant
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 'データ範囲の最終行取得
    Set dataRange = ws.Range("A2:A" & lastRow) 'データ範囲設定(A列)
    arrData = dataRange.Value '配列にデータを格納
    
    For i = LBound(arrData, 1) To UBound(arrData, 1)
        If Not dict.exists(arrData(i, 1)) Then
            dict.Add arrData(i, 1), Nothing
        End If
    Next i
    
    '重複データの配列作成
    Dim duplicates() As Variant
    ReDim duplicates(0 To dict.Count - 1)
    j = 0
    For Each key In dict.keys
        duplicates(j) = key
        j = j + 1
    Next key
    
    '結果表示（例）
    ws.Range("C2:C" & UBound(duplicates, 1) + 1).Value = Application.Transpose(duplicates)
    
    Application.ScreenUpdating = True '画面更新再開
End Sub