我在Sheet1,A列中有一个未排序的名单。许多名称在列表中出现不止一次。
在Sheet2列A上我想要按字母顺序排序的名称列表,没有重复值。
使用VBA实现此目标的最佳方法是什么?
到目前为止,我见过的方法包括:
答案 0 :(得分: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)
答案 1 :(得分:0)
如你所知,某种字典是关键。我会使用一个集合 - 它是内置的(与Scripting.Dictionary相反)并完成工作。
如果“最佳”表示“快速”,则第二个技巧是不单独访问每个单元格。而是使用缓冲区。即使有数千行输入,下面的代码也会很快。
代码:
' 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