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屋!