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

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-12 12:20:06  来源:igfitidea点击:

Get Unique Values Using Advanced Filters Not Working?

excelvbaexcel-vbaadvanced-filter

提问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.AdvancedFiltercommand 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