2个或更多列中的VBA唯一值

Question

我想创建一个宏，该宏可以从2个或更多列的组合中挑选出唯一的值，然后复制到另一个表中。

例如，如果我有这样的样本数据：

Account Category
AAA USD
AAA USD
AAA CAD
BBB USD
BBB USD

我希望能得到这个结果：

Account Category
AAA USD
AAA CAD
BBB USD

我已经从另一个线程中改编了这段代码，该线程使用collection查找仅一列的唯一性。现在，我有2列作为标准，有没有办法做到？

我需要比较的两列是D和AB。

Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets(1)
Set ws2 = ThisWorkbook.Worksheets(2)
Dim LastRowInput As Long
    LastRowInput = ws2.Cells.SpecialCells(xlCellTypeLastCell).Row

Dim AccArr As Variant, colUnique As Collection, i As Long, ArrOut As Variant
AccArr = ws2.Range("D2:D" & LastRowInput, "AB2:AB" & LastRowInput).Value
Set colUnique = New Collection

For i = LBound(AccArr) To UBound(AccArr)
    On Error Resume Next
        colUnique.Add AccArr(i, 1), CStr(AccArr(i, 1))
    On Error GoTo 0
Next i

ReDim ArrOut(1 To colUnique.Count, 1 To 1)

For i = 1 To colUnique.Count
    ArrOut(i, 1) = colUnique.Item(i)
Next i

ws1.Range("A10").Resize(UBound(ArrOut, 1), UBound(ArrOut, 2)).Value = ArrOut

先谢谢您。

Answer 1

AdvancedFilter可以快速提取两列唯一列表。

Option Explicit

Sub Macro1()

    With Worksheets("sheet3")
        .Range("D1:AB6").AdvancedFilter Action:=xlFilterCopy, _
                             CopyToRange:=.Range("AD1:AE1"), Unique:=True
    End With

End Sub

Answer 2

使用Range.RemoveDupicates：

Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets(1) 'realize the this is the index number and can error if the user moves the tabs around.
Set ws2 = ThisWorkbook.Worksheets(2)
Dim LastRowInput As Long
    LastRowInput = ws2.Cells(ws2.Rows.Count, 4).End(xlUp).Row

ws1.Range("A10:A" & LastRowInput + 8).Value = ws2.Range("D2:D" & LastRowInput).Value
ws1.Range("B10:B" & LastRowInput + 8).Value = ws2.Range("AB2:AB" & LastRowInput).Value
ws1.Range("A10:B" & LastRowInput + 8).RemoveDuplicates Array(1, 2), xlNo

Answer 3

我知道Scott已经发布了一个解决方案，但是您要做的就是：

Range("D1:AB6").Range("$D$1:$AB$6").RemoveDuplicates Columns:=Array(1, 25), Header:=xlNo

只要所选范围包含两列，数组值就会反映列索引。