excel vba - 将唯一值复制到新工作表 - NO HEADER

时间:2011-09-16 06:11:13

标签: excel vba

我在srcSheet中有A列,其中包含以下10个值:

bob
mary
sez
mary
mik
bob
tim
bob
ni
whit

我正在尝试将唯一值仅复制到另一张表中的A列,但我得到的第一个值是'bob'两次。我知道这是因为AdvancedFilter将第一行视为标题,但我想知道是否可以在VBA中完成此操作而不在上面添加标题行?

我的代码:

Set rSrc = Worksheets(srcSheet).Range("A1:10")
Set rTrg = Worksheets(trgSheet).Range("A1")

rSrc.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rTrg, Unique:=True

1 个答案:

答案 0 :(得分:3)

没有选项不包含标题。您可以在复制后删除顶部项目

With rTrg.offset(1,0)
   Range(.Item(1), .End(xlDown)).Cut rTrg
End With

...或类似的东西适用于您的特定工作表布局。

编辑:只是做这样的事情更加整洁

Sub Tester()
    CopyUniques Sheet1.Range("C4").CurrentRegion, Sheet1.Range("e4")
End Sub


Sub CopyUniques(rngCopyFrom As Range, rngCopyTo As Range)
    Dim d As Object, c As Range, k
    Set d = CreateObject("scripting.dictionary")
    For Each c In rngCopyFrom
        If Len(c.Value) > 0 Then
            If Not d.Exists(c.Value) Then d.Add c.Value, 1
        End If
    Next c
    k = d.keys
    rngCopyTo.Resize(UBound(k) + 1, 1).Value = Application.Transpose(k)
End Sub