Excel VBA 宏：匹配 A 列和 B 列，将重复项复制到 Sheet2答案

【问题标题】：Excel VBA Macro: Match Column A and B, copy duplicates to Sheet2Excel VBA 宏：匹配 A 列和 B 列，将重复项复制到 Sheet2
【发布时间】：2014-09-22 01:10:32
【问题描述】：

我在找出一个宏来帮助我处理一些数据时遇到了一些麻烦。我遇到了几个几乎可以满足我需要的宏，但我对语言的了解还不够，无法弄清楚。这就是我正在使用的。

A 列 - 软件列表。

B 列 - 软件版本。

C 列 - 安装它的计算机名称。

我在寻找什么。我需要一个宏来搜索与 A 列和 B 列匹配的重复项。如果它有重复项，我需要它来将重复项和原始行复制到 Sheet2。

现在 Sheet2 上应该只有重复的项目。是否可以再次搜索重复项（A&B 列），当它匹配时，C 列的 JoinRange 一起。然后删除重复项。

例如： A栏（软件）

Adobe Reader X

Adobe Reader XI

B 列（版本）

10.1.6

10.1.7

11.0.03

C 列（计算机）

计算机1，计算机2

电脑3，电脑4

计算机 5、计算机 6

计算机7，计算机8

电脑9，电脑10

成品将是：

A栏

Adobe Reader X

Adobe Reader XI

B 栏

10.1.6

10.1.7

11.0.03

C 列

计算机 1、计算机 2、计算机 3、计算机 4

计算机 5、计算机 6

计算机 7、计算机 8、计算机 9、计算机 10

我不确定这是否可行，但我肯定可以使用一些指导。

V/r, 布雷特

【问题讨论】：

标签： vba excel duplicates

【解决方案1】：

很简单。添加一个名为“重复项”的工作表，然后选择要检查重复项的工作表，然后确保工作表首先按列 A 排序，然后按列 B，然后运行此宏：

    Sub GetDuplicates()
    On Error GoTo errGetDuplicates
    d = 1
    x = 1
    Do Until Cells(x, 1) = "" 'Looks at each row until it reaches the end
        If Cells(x, 1) = Cells(x + 1, 1) Then 'Checks Col 1 for duplicates
            If Cells(x, 2) = Cells(x + 1, 2) Then 'Checks Col 2 for duplicates
                Sheets("Duplicates").Cells(d, 1) = Cells(x, 1)
                Sheets("Duplicates").Cells(d, 2) = Cells(x, 2)
                Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
                d = d + 1
                x = x + 1
                Sheets("Duplicates").Cells(d, 1) = Cells(x, 1)
                Sheets("Duplicates").Cells(d, 2) = Cells(x, 2)
                Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
                d = d + 1
            End If
        End If
doneWithError:
        x = x + 1
    Loop

    Exit Sub

errGetDuplicates:
    If Err = 1004 Then
        array1 = Split(Cells(x, 1), " ")
        array2 = Split(Cells(x + 1, 1), " ")

        For a = 0 To UBound(array1)
            If Not array1(a) = array2(a) Then GoTo unmatched
        Next a

        array3 = Split(Cells(x, 2), " ")
        array4 = Split(Cells(x + 1, 2), " ")

        For a = 0 To UBound(array1)
            If Not array3(a) = array4(a) Then GoTo unmatched
        Next a

        Sheets("Duplicates").Cells(d, 1) = Join(array1, " ")
        Sheets("Duplicates").Cells(d, 2) = Join(array3, " ")
        Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
        d = d + 1
        x = x + 1
        Sheets("Duplicates").Cells(d, 1) = Join(array2, " ")
        Sheets("Duplicates").Cells(d, 2) = Join(array4, " ")
        Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
        d = d + 1

        GoTo doneWithError

    End If

    End Sub

【讨论】：

马修，感谢您的快速回复。该宏在大多数情况下都很好用......每当它到达一个包含大量信息的单元格时，我都会遇到错误。它说“运行时错误'1004'应用程序定义或对象定义的错误”它不会将其复制到重复表。有什么建议吗？
我怀疑这是问题所在。 Duplicates 表是否命名为 Duplicates？在宏完成之前，您是否一直选择要在其上运行的工作表？您正在运行的工作表是否正确排序？如果这些都不是问题，请张贴表格，我会帮助您解决问题。
我刚刚检查过，它们的排序正确。它可以正确运行几行，但会挂断。我检查了它挂断的单元格并将其复制到 Word 中，有 830 个单词（4 页）的文本。
我开始删除单元格中的一些信息，看看是否是问题所在。我得到了 505 个字（3 页）的信息，它能够运行宏通过它，但在下一个更大的单元格中被挂断了。
哇。那是很多。我以前从未听说过这种情况。如果按break键调试，是哪一行代码报错？