使用高级筛选器获取唯一值不起作用?

我有两张床单:

第2页:

Column C Supplier Name A A B B C 

表1(预期结果)

 Column G A B C 

我试图在表1的G列中创build一个唯一的供应商名称列表,如上所示。

我正在使用这个代码:

 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 

此代码无法正常工作。 它显示了第一个供应商名称A重复如下所示:

表1

 Column G A A B C 

高级filter需要在“复制到”操作中传送的标题行。 由于您没有分配或包含一个,因此r1.AdvancedFilter命令假定C2是标题行。

Range("C2:C" & lastrow)更改为Range("C1:C" & lastrow)以便高级filter具有标题行来传递。

 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 

请注意,您将携带C1到Sheet1!G16。 如果不需要,请删除它。

替代直接值转移和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