如何在 Excel 中使用 VBA 查找重复项并分别列出它们？答案

【问题标题】：How to find duplicates and list them separately using VBA in Excel?如何在 Excel 中使用 VBA 查找重复项并分别列出它们？
【发布时间】：2018-12-05 22:56:29
【问题描述】：

我有一个用于导入 XML 数据的工作表。我想使用 VBA 来查找数据范围内的重复项（仅在一列中）并提取重复项及其出现的次数，如下图所示。应保留原始数据，因为我将不断向列中添加新的 XML 数据。至于现在，我只找到了突出显示或删除重复项的方法，但我想通过一个单独的列表来更好地可视化数据，以查看重复次数最多的数据。我只对重复项感兴趣，因此可以忽略只出现一次的数据。

编辑：我有数千或行数据要处理，我不确定哪些数据会有重复，所以我认为对每一行使用 countif 效率很低。

谢谢！

This is how it should look

【问题讨论】：

你可以使用 Excel 函数，例如 count if 和删除重复项，而不是 VBA。
@techie 我正在使用 VBA 来导入 XML，所以如果我可以对所有内容进行宏处理就好了。计数是否有趣，但我应该补充一点，每个单元格中的数据很长，我不知道它们到底是什么（不像 AAA 或 BBB 那样简单），但我知道会有重复。
快速浏览一下这里的例子：stackoverflow.com/questions/36044556/… 或这里analysistabs.com/vba/find-duplicate-values-column。尝试使用这些代码，然后回来告诉我们您的代码中哪里有问题。
How can I remove duplicate rows? 的可能重复项每天都会在这里发布此类问题。请做一些研究
@Rawrplus 正如问题中提到的，我已经完成了我的研究并找到了删除重复行的方法，但这不是我想要的。

标签： xml excel vba list duplicates

【解决方案1】：

测试和工作：

Option Explicit

Sub find_dups()

    ' Create and set variable for referencing workbook
    Dim wb As Workbook
    Set wb = ThisWorkbook

    ' Create and set variable for referencing worksheet
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Data")

    ' Find current last rows
    ' For this example, the data is in column A and the duplicates are in column C
    Dim lngLastRowData As Long
    lngLastRowData = ws.Range("a1048576").End(xlUp).Row
    Dim lngLastRowDups As Long
    lngLastRowDups = ws.Range("c1048576").End(xlUp).Row

    ' Create and set a variable for referencing data range
    Dim rngData As Range
    Set rngData = ws.Range("a2:a" & lngLastRowData)

    Dim lngRowCount As Long
    lngRowCount = 0

    Dim clData As Variant
    Dim lngCount As Long

    Dim lngRowIndexData As Long
    Dim lngRowIndexDups As Long
    lngRowIndexDups = lngLastRowDups + 1

    ' Variable to store those values we've already checked
    Dim strAlreadySearched As String


    For Each clData In rngData.Cells

        ' Reset variables
        lngCount = 0


        ' See if we've already searched this value
        If InStr(1, strAlreadySearched, "|" & clData.Value & "|") = 0 Then

            ' We haven't, so proceed to compare to each row
            For lngRowIndexData = 1 To lngLastRowData

                ' If we have a match, count it
                If rngData.Cells(lngRowIndexData, 1).Value = clData.Value Then
                    lngCount = lngCount + 1
                End If

            Next lngRowIndexData

            ' If more than 1 instance
            If lngCount > 1 Then
                ' Dup's were found, fill in values under duplicates
                ws.Cells(lngRowIndexDups, 3).Value = clData.Value
                ws.Cells(lngRowIndexDups, 4).Value = lngCount

                ' Drop down a row
                lngRowIndexDups = lngRowIndexDups + 1

                ' Capture this value so we don't search it again
                strAlreadySearched = strAlreadySearched & "|" & clData.Value & "|"


            End If
        End If

    Next clData



End Sub

【讨论】：

感谢@SeanW333 的全面回答。虽然我花了一些时间来完成代码，但它工作得很好，没想到这会很长。但是，我很好奇如何检查两列上的重复项？仅当有多个相邻的两个单元格时才算作重复。作为初学者，对我来说最简单的方法是将两列中的每一行连接成一列，然后使用上面的代码，但我猜应该有更好的方法？
其实串联方法是完全有效的。但是，如果您觉得这很奇怪，您也可以将 If rngData.Cells(lngRowIndexData, 1).Value = clData.Value Then 替换为 If rngData.Cells(lngRowIndexData, 1).Value = clData.Value AND rngData.Cells(lngRowIndexData, 2).Value = clData.Offset(0,1).Value Then（假设附加列是主列右侧的列），这样可以达到同样的效果。

【解决方案2】：

您可以在 vba 代码中使用 range("a:a").RemoveDuplicates。这将删除所有重复项。或者您可以使用条件格式为重复项着色。

enter image description here

【讨论】：