Modo più veloce per ottenere tutti i valori univoci di una colonna in VBA?

C’è un modo più veloce per farlo?

Set data = ws.UsedRange Set unique = CreateObject("Scripting.Dictionary") On Error Resume Next For x = 1 To data.Rows.Count unique.Add data(x, some_column_number).Value, 1 Next x On Error GoTo 0 

A questo punto unique.keys ottiene ciò di cui ho bisogno, ma il loop stesso sembra essere molto lento per i file che hanno decine di migliaia di record (mentre questo non sarebbe un problema in un linguaggio come Python o C ++ in particolare).

Caricare i valori in un array sarebbe molto più veloce:

 Dim data(), unique As Variant, r As Long data = ws.UsedRange.Value Set unique = CreateObject("Scripting.Dictionary") For r = 1 To UBound(data) unique(data(r, some_column_number)) = Empty Next r 

È inoltre necessario considerare l’associazione anticipata per Scripting.Dictionary:

 Dim unique As New Scripting.Dictionary 

Usa la funzione AdvancedFilter di Excel per farlo (usare Excel inbuilt C ++ è il modo più veloce).

Copia i valori nella colonna A e inserisci i valori univoci nella colonna B:

 Range("A1:A6").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True 

Funziona anche con più colonne:

 Range("A1:B4").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1:E1"), Unique:=True 

PowerShell è uno strumento molto potente ed efficiente. Questo è un imbroglio un po ‘, ma il bombardamento di PowerShell tramite VBA apre molte opzioni

La maggior parte del codice qui sotto è semplicemente per salvare il foglio corrente come un file CSV . L’output è un altro file CSV con solo i valori univoci

 Sub AnotherWay() Dim strPath As String Dim strPath2 As String Application.DisplayAlerts = False strPath = "C:\Temp\test.csv" strPath2 = "C:\Temp\testout.csv" ActiveWorkbook.SaveAs strPath, xlCSV x = Shell("powershell.exe $csv = import-csv -Path """ & strPath & """ -Header A | Select-Object -Unique A | Export-Csv """ & strPath2 & """ -NoTypeInformation", 0) Application.DisplayAlerts = True End Sub 

Prova questo

 Option Explicit Sub UniqueValues() Dim ws As Worksheet Dim uniqueRng As Range Dim myCol As Long myCol = 5 '<== set it as per your needs Set ws = ThisWorkbook.Worksheets("unique") '<== set it as per your needs Set uniqueRng = GetUniqueValues(ws, myCol) End Sub Function GetUniqueValues(ws As Worksheet, col As Long) As Range Dim firstRow As Long With ws .Columns(col).RemoveDuplicates Columns:=Array(1), header:=xlNo firstRow = 1 If IsEmpty(.Cells(1, col)) Then firstRow = .Cells(1, col).End(xlDown).row Set GetUniqueValues = Range(.Cells(firstRow, col), .Cells(.Rows.Count, col).End(xlUp)) End With End Function 

dovrebbe essere abbastanza veloce e senza l'inconveniente di cui parlava NeepNeepNeep