vba 使用高级过滤器获取唯一值不起作用?
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/42940366/
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
Get Unique Values Using Advanced Filters Not Working?
提问by user7415328
I have two sheets:
我有两张纸:
Sheet 2:
第 2 页:
Column C
Supplier Name
A
A
B
B
C
Sheet 1 (Desired Result)
第 1 页(预期结果)
Column G
A
B
C
I am trying to create a list of unique supplier names in column G on Sheet 1, as shown above.
我正在尝试在工作表 1 的 G 列中创建一个唯一供应商名称列表,如上所示。
I am using this code:
我正在使用此代码:
Sub LIST()
Dim r1 As Range, r2 As Range
Dim lastrow As Long
lastrow = Sheets("Data").Cells(Rows.Count, "C").End(xlUp).row
Set r1 = Sheets("Data").Range("C2:C" & lastrow)
Set r2 = Sheets("Sheet1").Range("G16")
r1.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=r2, unique:=True
End Sub
This code is not working correctly. It shows the first supplier name A as duplicated like so:
此代码无法正常工作。它显示第一个供应商名称 A 重复,如下所示:
Sheet 1
第 1 页
Column G
A
A
B
C
采纳答案by user7415328
Advanced Filter requires a header row that it carries across in a Copy To operation. Since you have not assinged or included one, the r1.AdvancedFilter
command assumes that C2 is the header row.
高级过滤器需要一个标题行,它在复制到操作中进行。由于您尚未分配或包含一个,因此该r1.AdvancedFilter
命令假定 C2 是标题行。
Change Range("C2:C" & lastrow)
to Range("C1:C" & lastrow)
so that Advanced Filter has a header row to carry across.
更改Range("C2:C" & lastrow)
为,Range("C1:C" & lastrow)
以便高级过滤器有一个标题行可以传递。
Sub LIST()
Dim r1 As Range, r2 As Range
Dim lastrow As Long
lastrow = Sheets("Data").Cells(Rows.Count, "C").End(xlUp).Row
Set r1 = Sheets("Data").Range("C1:C" & lastrow)
Set r2 = Sheets("Sheet1").Range("G16")
r1.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=r2, Unique:=True
End Sub
Note that you will be carrying C1 across to Sheet1!G16. Delete it if is not desired.
请注意,您将把 C1 带到 Sheet1!G16。如果不需要,请删除它。
Alternate with direct value transfer and RemoveDuplicates instead of AdvancedFilter.
交替使用直接值传输和 RemoveDuplicates 而不是 AdvancedFilter。
Sub nodupeLIST()
Dim r1 As Range, lastrow As Long
With Worksheets("Data")
lastrow = .Cells(Rows.Count, "C").End(xlUp).Row
Set r1 = .Range("C2:C" & lastrow)
End With
With Worksheets("Sheet1")
With .Range("G16").Resize(r1.Rows.Count, 1)
.Cells = r1.Value
.RemoveDuplicates Columns:=1, Header:=xlNo
End With
End With
End Sub