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

我在Sheet1，A列中有一个未排序的名称列表。其中许多名称在列表中多次出现。VBA：将范围中的不同值添加到新范围

在Sheet2列A我想要一个没有重复值的按字母顺序排列的名称列表。

使用VBA实现此目标的最佳方法是什么？

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

制作与CStr的（名字）为重点的集合，通过循环范围，并尝试添加每个名称;如果出现错误，它不是唯一的，请忽略它，否则将范围扩大1个单元格并添加名称
与（1）相同，但忽略关于错误的内容。循环完成时，集合中只有唯一值：然后将整个集合添加到范围
使用范围上的匹配工作表函数：如果不匹配，则将范围扩大一个单元格并添加名称
也许一些模拟的数据选项卡上的“删除重复”按钮？（还没有研究过）

来源

2012-05-09 Swiftslide

我会去与选项4 1）录制宏2）复制柱A到第二页3）选择柱A，然后按删除数据选项卡下的复制按钮，如果你正在使用Excel 2007 4）对数据进行排序:)试一试，如果你被卡住了，然后回发:) –

+1对于Siddharth的答案。这应该很容易。 –

这样的问题在SO上被问过太多次了......看看以前的答案（[例如]（http://stackoverflow.com/a/5896692/119775）），尝试一下，看看它是否工作，回到我们有任何问题。 [This]（http://meta.stackexchange.com/a/5235/164088）和[this]（http://stackoverflow.com/questions/how-to-ask）也会对你有用。 –

如你所说，某种类型的字典是关键。我会使用一个集合 - 它是内置的（与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

来源

2012-05-10 07:33:30

我真的很喜欢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)

来源

2012-05-10 01:37:18 Brad

您可以使用dic.keys在一个步骤中将字典键阵列转置为该范围。试试吧:) – aevanko

哦有趣。我喜欢。我更新了我的答案以显示此更改！ – Brad

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

回答

相关问题