excel vba - 将唯一值复制到新表 - NO HEADER [英] excel vba - copy unique values to new sheet - NO HEADER

问题描述

我在srcSheet中的列A中有以下10个值：

I have column A in the srcSheet with the following 10 values:

bob
mary
sez
mary
mik
bob
tim
bob
ni
whit

我试图将唯一值复制到另一个工作表中的列A，但是我获得了第一个值bob两次。我知道这是因为AdvancedFilter将第一行视为标题，但是我想知道这是否可以在VBA中完成，而无需放置上面的标题行？

I'm trying to copy the unique values only to column A in another sheet but I'm getting the first value 'bob' twice. I know this is because AdvancedFilter treats first row as a header but I want to know if this can be done in VBA without putting in a header row above?

我的代码：

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

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

推荐答案

没有选项不包括标题。您可以删除副本后的顶级项目

There's no option to not include the header. You could delete the top item after the copy

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

或者类似的东西与您的特定工作表布局一致。

...or something similar which works with your particular sheet layout.

编辑：更简单的做这样的事情

much tidier to just do something like this

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

这篇关于excel vba - 将唯一值复制到新表 - NO HEADER的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！