基于两个单元格的唯一列表

Question

我正在使用以下代码提取唯一客户列表，我想基于F列和K列两列的组合提取列表。有没有一种方法可以更新此代码，即有效吗？

Sub FilterUniqueCustomer()
  Application.ScreenUpdating = False

  'Advance Filter
  Range("F1").Select
  Application.CutCopyMode = False
  Application.CutCopyMode = False
  Range("F1:F100").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
    "S1"), Unique:=True
  ActiveWindow.SmallScroll Down:=-6

  'Copy Values      
  Range("T2:T100").Select
  Selection.copy
  Range("U2").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

  'Clear Formatting      
  Range("N4").Select
  Selection.copy
  Columns("S:S").Select
  Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False 'Clears clipboard

  Call DeleteZerosCustomer
  Application.ScreenUpdating = True

End Sub

Answer 1

像这样使用字典来获得唯一的组合和数组，使其比工作表中的工作更快。

Option Explicit
Sub TEST()
    Application.ScreenUpdating = False
    Dim arr(), i As Long, dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet3")                    '<==Change as required
        arr = .Range("F1:K6").Value
        For i = LBound(arr, 1) To UBound(arr, 1)
            dict(arr(i, 1) & "," & arr(i, 6)) = 1
        Next
    End With

    Dim key As Variant, rowCounter As Long
    For Each key In dict.keys
        rowCounter = rowCounter + 1
        Worksheets("Sheet2").Cells(rowCounter + 1, 1).Resize(1, 2) = Split(key, ",")  '<== Change output sheet as required
    Next
    Application.ScreenUpdating = True
End Sub