Copy unique values in Excel VBA

问题

I have written VBA code that copies a filtered table from one spreadsheet to another. This is the code:

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

The filter is applied before the code is ran and then the code selects the visible cells and copies them so as to get only those rows that passed the filter.

In the filtered table to be copied I have, in column L of the range, a certain set of names, some of which are repeated in several rows.

I would like to add to the code so that it only copies one row per name in column L. In other words, I would like the code to copy only the first row for each of the names that appears in Column L of the filtered table.

回答1:

Pehaps something like this can help you. Code will loop through your rows (5 to 584). First it checks if row is hidden. If not, will check if the value in column "L" is already in the Dictionary. If it is not, it will do two things: copy the row to Destination Sheet, and add the value to the 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

回答2:

You could apply another filter to the table to only show the first occurrence of each set of names and then run your macro as usual. See this answer:

https://superuser.com/a/634284

来源：https://stackoverflow.com/questions/45482245/copy-unique-values-in-excel-vba

标签

excel

vba

filter

copy