有更快的方法吗？
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 得到了我需要的东西，但是对于具有数万条记录的文件，循环本身似乎非常慢（而在 Python 或 C++ 这样的语言中这根本不是问题特别是）。
【问题讨论】：
在数组中加载值会快得多：
Dim data(), dict As Object, r As Long
Set dict = CreateObject("Scripting.Dictionary")
data = ActiveSheet.UsedRange.Columns(1).Value
For r = 1 To UBound(data)
dict(data(r, some_column_number)) = Empty
Next
data = WorksheetFunction.Transpose(dict.keys())
您还应该考虑对 Scripting.Dictionary 进行早期绑定：
Dim dict As New Scripting.Dictionary ' requires `Microsoft Scripting Runtime` '
请注意，在大型数据集上使用字典比 Range.AdvancedFilter 快得多。
作为奖励，这是一个类似于Range.RemoveDuplicates 的过程，用于从二维数组中删除重复项：
Public Sub RemoveDuplicates(data, ParamArray columns())
Dim ret(), indexes(), ids(), r As Long, c As Long
Dim dict As New Scripting.Dictionary ' requires `Microsoft Scripting Runtime` '
If VarType(data) And vbArray Then Else Err.Raise 5, , "Argument data is not an array"
ReDim ids(LBound(columns) To UBound(columns))
For r = LBound(data) To UBound(data) ' each row '
For c = LBound(columns) To UBound(columns) ' each column '
ids(c) = data(r, columns(c)) ' build id for the row
Next
dict(Join$(ids, ChrW(-1))) = r ' associate the row index to the id '
Next
indexes = dict.Items()
ReDim ret(LBound(data) To LBound(data) + dict.Count - 1, LBound(data, 2) To UBound(data, 2))
For c = LBound(ret, 2) To UBound(ret, 2) ' each column '
For r = LBound(ret) To UBound(ret) ' each row / unique id '
ret(r, c) = data(indexes(r - 1), c) ' copy the value at index '
Next
Next
data = ret
End Sub
【讨论】：
.Keys() 来获取数组中的唯一值。
试试这个
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 所说的缺点
【讨论】：
使用 Excel 的 AdvancedFilter 函数来执行此操作。
使用 Excels 内置的 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
小心使用多个列，因为它并不总是按预期工作。在这些情况下，我会通过选择一组列来确定唯一性来删除重复项。参考：MSDN - Find and remove duplicates
这里我根据第三列删除重复的列：
Range("A1:C4").RemoveDuplicates Columns:=3, Header:=xlNo
这里我根据第二列和第三列删除重复的列：
Range("A1:C4").RemoveDuplicates Columns:=Array(2, 3), Header:=xlNo
【讨论】：
AdvancedFilter 方法将数据仅放入“VBA-可见”变量，如数组或字典（即工作表中没有“物理”存在） . 2.我找不到怎么做，这个AdvancedFilter方法真的提供了粘贴为值的选项吗？
AdvancedFilter 不是最快的方法。在大型数据集上，使用字典将优于 AdvancedFilter（约 500 毫秒 vs 约 60 秒对于 10 万个单元格）。
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
【讨论】：
这很有趣，因为我不得不一遍又一遍地阅读这些说明，但它认为我找到了一个更快的方法来做到这一点：
Set data = ws.UsedRange
dim unique as variant
unique = WorksheetFunction.Unique(data)
然后你可以对 unique 数组做任何你想做的事情，比如迭代它：
For i = LBound(unique) To UBound(unique)
Range("Q" & i) = indexes(i, 1)
Next
【讨论】：
unique = WorksheetFunction.unique(Columns(1))