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

我在srcSheet中有A列，其中包含以下10个值：

bob
mary
sez
mary
mik
bob
tim
bob
ni
whit

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

我的代码：

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

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

1 回答

没有选项不包括 Headers . 您可以在复制后删除顶部项目

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

回复于 2024-04-29T22:12:46+08:00

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

1 回答

相关问题