Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.1k views
in Technique[技术] by (71.8m points)

vba - Get Unique Values Using Advanced Filters Not Working?

I have two sheets:

Sheet 2:

Column C
Supplier Name
A
A
B
B
C

Sheet 1 (Desired Result)

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.

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:

Sheet 1

Column G
A
A
B
C
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

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.

Change Range("C2:C" & lastrow) to Range("C1:C" & lastrow) so that Advanced Filter has a header row to carry across.

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.

Alternate with direct value transfer and RemoveDuplicates instead of 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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...