在VBA中获得列的所有唯一值的更快方法?

有没有更快的方法来做到这一点?

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 

在这一点上, unique.keys得到了我所需要的,但是对于有成千上万条logging的文件来说,循环本身似乎非常缓慢(而在Python或C ++这样的语言中,这完全不成问题)。

在数组中加载值会快得多:

 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 

您还应该考虑早期绑定Scripting.Dictionary:

 Dim unique As New Scripting.Dictionary 

使用Excel的AdvancedFilter函数来执行此操作(使用Excels inbuilt C ++是最快的方法)。

在列A中复制值并在列B中插入唯一值:

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

它也适用于多列:

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

PowerShell是一个非常强大和高效的工具。 这是有点作弊的,但通过VBA炮击PowerShell打开了很多选项

下面的大部分代码只是将当前工作表保存为csv文件。 输出是另一个csv文件,只有唯一的值

 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 

尝试这个

 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 

它应该是相当快,没有缺点NeepNeepNeep告诉