excel vba - 将唯一值复制到新工作表 - 无标题
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/7440821/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
excel vba - copy unique values to new sheet - NO HEADER
提问by toop
I have column A in the srcSheet with the following 10 values:
我在 srcSheet 的 A 列中有以下 10 个值:
bob
mary
sez
mary
mik
bob
tim
bob
ni
whit
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?
我试图将唯一值仅复制到另一张工作表中的 A 列,但我两次获得第一个值“bob”。我知道这是因为 AdvancedFilter 将第一行视为标题,但我想知道这是否可以在 VBA 中完成而无需在上面放置标题行?
my code:
我的代码:
Set rSrc = Worksheets(srcSheet).Range("A1:10")
Set rTrg = Worksheets(trgSheet).Range("A1")
rSrc.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rTrg, Unique:=True
回答by Tim Williams
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.
...或类似的东西,适用于您的特定工作表布局。
EDIT: 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