来自 2 列或更多列的 VBA 唯一值答案

【问题标题】：VBA Unique values from 2 or more columns来自 2 列或更多列的 VBA 唯一值
【发布时间】：2018-07-13 18:37:10
【问题描述】：

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

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

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

我希望得到这个结果：

Account Category
AAA USD
AAA CAD
BBB USD

我已经从另一个线程改编了这段代码，该线程使用集合来查找仅一列的唯一值。现在我有 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

提前谢谢你。

【问题讨论】：

标签： excel vba collections unique multiple-columns

【解决方案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

【讨论】：

【解决方案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

【讨论】：

嗯，我从来没有想到过这么简单的解决方案。谢谢！
数据粘贴到的工作表（1）下面已经有数据了，所以这个方法会在删除之前覆盖它。我想在粘贴到我想要的位置之前，我需要将这些步骤锁定在一个数组或变量中？
使用@jeeped 的答案，它将在内存中进行删除。但是如果下面有数据，你怎么知道即使是唯一的也不会覆盖呢？
啊完美。每个实例上的唯一值通常不超过 4 行。所以我一直在寻找一种更快的方法来预填充现有模板。谢谢两位的建议。

【解决方案3】：

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

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

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

【讨论】：

除非OP想要另一个工作表范围内的唯一值而不是删除原始数据。
@ScottCraner Ahh 我没注意到。