Question

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

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

谢谢！

This is how it should look

Answer 1

您可以使用range（“ a：a”）。在vba代码中删除重复项。这将删除所有重复项。或者，您可以使用条件格式为重复项上色。

enter image description here

Answer 2

经过测试，可以正常工作：

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

如何在Excel中使用VBA查找重复项并将其单独列出？

2 个答案: