在Excel VBA中复制唯一值

-1

我已经编写了VBA代码，可以将一个过滤表格从一个电子表格复制到另一个电子表格。这是代码：在Excel VBA中复制唯一值

Option Explicit 

Public Sub LeadingRetailers() 
    Dim rngRows As Range 

    Set rngRows = Worksheets("StoreDatabase").Range("B5:N584") 
    With rngRows 
     .SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("LeadingRetailersAUX").Range("B2") 
    End With 

Sheets("Leading Retailers").Activate 

End Sub

代码运行前的过滤器被应用，然后将代码选择可见单元格，并将它们复制这样才能得到只有那些通过了过滤器行。

在要复制的过滤表中，我在该范围的L列中有一组名称，其中一些名称在几行中重复。

我想添加到代码中，以便它只在列L中为每个名称复制一行。换句话说，我希望代码只复制出现在列L中的每个名称的第一行的过滤表。

来源

2017-08-03 franciscofcosta

Pehaps这样的事情可以帮助你。代码将遍历你的行（5到584）。首先检查行是否隐藏。如果不是，将检查列“L”中的值是否已经在Dictionary中。如果不是，则会执行两项操作：将该行复制到目标工作表，然后将该值添加到Dictionary中。

Option Explicit 

Public Sub LeadingRetailers() 
    Dim d As Object 
    Dim i As Long 
    Dim k As Long 

    Set d = CreateObject("scripting.dictionary") 
    i = 2 'first row of pasting (in "LeadingRetailersAUX") 
    For k = 5 To 584 
     If Not (Worksheets("StoreDatabase").Rows(k).RowHeight = 0) Then 'if not hidden 
      If Not d.Exists(Worksheets("Hoja1").Cells(k, 12).Value) Then 'if not in Dictionary 
       d.Add Worksheets("StoreDatabase").Cells(k, 12).Value, i 'Add it 
       Worksheets("LeadingRetailersAUX").Cells(i, 2).EntireRow.Value = Worksheets("StoreDatabase").Cells(k, 1).EntireRow.Value 
       i = i + 1 
      End If 
     End If 
    Next 

End Sub

来源

2017-08-03 12:29:25 CMArg

您可以对表格应用另一个过滤器，以仅显示每组名称的第一次出现，然后照常运行宏。看到这个答案：

https://superuser.com/a/634284

来源

2017-08-03 11:06:40 tdsymonds

谢谢。问题是，过滤器也通过VBA应用，我需要这一点也在VBA中。 – franciscofcosta

啊我看到了......也许有一种方法可以在VBA中应用这种“高级过滤器”，但很遗憾我不知道该怎么做。 – tdsymonds

谢谢你。 – franciscofcosta

在Excel VBA中复制唯一值

回答

相关问题