Question

我编写了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列中出现的每个名称的第一行。过滤后的表格。

Answer 1

这样的事情可以帮助你。代码将循环遍历您的行（5到584）。首先，它检查行是否隐藏。如果没有，将检查列“L”中的值是否已经在字典中。如果不是，它将做两件事：将行复制到Destination Sheet，然后将值添加到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

Answer 2

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

https://superuser.com/a/634284

在Excel VBA中复制唯一值

2 个答案: