Как найти дубликаты и перечислить их отдельно, используя VBA в Excel? - PullRequest
Новая
       10

Как найти дубликаты и перечислить их отдельно, используя VBA в Excel?

0 голосов
/ 27 июня 2018

У меня есть лист, который я использую для импорта данных XML. Я хотел бы использовать VBA, чтобы найти дубликаты в пределах диапазона данных (только в одном столбце) и извлечь дубликаты вместе с количеством раз, которое они появляются, как показано на рисунке ниже. Исходные данные должны быть сохранены, так как я буду постоянно добавлять в столбец новые данные XML. На данный момент я нашел только способы выделить или удалить дубликаты, но я хочу лучше визуализировать данные, имея отдельный список, чтобы увидеть данные, которые повторяются чаще всего. Меня интересуют только дубликаты, поэтому данные, которые появляются только один раз, можно игнорировать.

РЕДАКТИРОВАТЬ: у меня есть тысячи или строки данных для работы, и я не буду уверен, какие из них будут иметь дубликаты, поэтому я думаю, что использование countif с каждой строкой было бы довольно неэффективно.

Спасибо!

Вот так это должно выглядеть

Ответы [ 2 ]

0 голосов
/ 27 июня 2018

Проверено и работает: 

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
0 голосов
/ 27 июня 2018

Вы можете использовать диапазон ("a: a"). RemoveDuplicates в коде VBA. Это удалит все дубликаты. Или вы можете использовать условное форматирование для дублирования цветов.

введите описание изображения здесь

...