VBA：将范围内的不同值添加到新范围

我在Sheet1，列A中有一个未sorting的名称列表。其中的许多名称在列表中多次出现。

在Sheet2上列AI需要一个按字母顺序排列的名称列表，没有重复的值。

用VBA实现这个的最佳方法是什么？

到目前为止，我所看到的方法包括：

1. 以CStr（name）作为关键字的集合，循环遍历范围并尝试添加每个名称; 如果出现错误，则不是唯一的，请忽略它，否则将范围扩大1个单元格并添加名称
2. 与（1）相同，除了忽略错误。 当循环完成时，集合中只有唯一的值：那么将整个集合添加到范围
3. 在范围上使用匹配工作表函数：如果不匹配，请将范围扩大一个单元格并添加名称
4. 也许一些模拟的数据选项卡上的“删除重复”button？ （没有看过这个）

Answer 1

正如你所build议的，某种字典是关键。 我会使用一个集合 – 它是内置的（与Scripting.Dictionary相反）并完成这项工作。

如果“最优”是指“快”，则第二个技巧是不单独访问每个单元格。 而是使用缓冲区。 即使有数千行的input，下面的代码也会很快。

码：

' src is the range to scan. It must be a single rectangular range (no multiselect). ' dst gives the offset where to paste. Should be a single cell. ' Pasted values will have shape N rows x 1 column, with unknown N. ' src and dst can be in different Worksheets or Workbooks. Public Sub unique(src As Range, dst As Range) Dim cl As Collection Dim buf_in() As Variant Dim buf_out() As Variant Dim val As Variant Dim i As Long ' It is good practice to catch special cases. If src.Cells.Count = 1 Then dst.Value = src.Value ' ...which is not an array for a single cell Exit Sub End If ' read all values at once buf_in = src.Value Set cl = New Collection ' Skip all already-present or invalid values On Error Resume Next For Each val In buf_in cl.Add val, CStr(val) Next On Error GoTo 0 ' transfer into output buffer ReDim buf_out(1 To cl.Count, 1 To 1) For i = 1 To cl.Count buf_out(i, 1) = cl(i) Next ' write all values at once dst.Resize(cl.Count, 1).Value = buf_out End Sub 

Answer 2

我真的很喜欢VBA中的字典对象。 这不是本地可用，但它是非常有能力的。 您需要添加对Microsoft Scripting Runtime的引用，然后您可以执行以下操作：

 Dim dic As Dictionary Set dic = New Dictionary Dim srcRng As Range Dim lastRow As Integer Dim ws As Worksheet Set ws = Sheets("Sheet1") lastRow = ws.Cells(1, 1).End(xlDown).Row Set srcRng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 1)) Dim cell As Range For Each cell In srcRng If Not dic.Exists(cell.Value) Then dic.Add cell.Value, cell.Value 'key, value End If Next cell Set ws = Sheets("Sheet2") Dim destRow As Integer destRow = 1 Dim entry As Variant 'the Transpose function is essential otherwise the first key is repeated in the vertically oriented range ws.Range(ws.Cells(destRow, 1), ws.Cells(dic.Count, 1)) = Application.Transpose(dic.Items)