VBA для проверки дубликатов на основе нескольких столбцов и отображения того, какая строка дублируется с какой.

В моем excel есть данные из столбца от A до AH, и я пытаюсь сделать следующее:

  1. Проверьте дубликат на основе первых трех столбцов
  2. Вставьте столбец в качестве первого столбца и отметьте повторяющиеся строки как дубликаты вместе с номером строки, которая дублируется.

Я пробовал с приведенными ниже кодами, которые основаны на одном столбце, но мне было трудно сделать несколько столбцов и указать количество строк, любая мысль будет оценена.

 Sub FindDuplicatesInColumn()
'Declaring the lastRow variable as Long to store the last row value in the Column1
    Dim lastRow As Long

'matchFoundIndex is to store the match index values of the given value
    Dim matchFoundIndex As Long

'iCntr is to loop through all the records in the column using For loop
    Dim iCntr As Long

'test the column A and insert a column or clear data
    If Range("A1").Value = "PDBC_PFX" Then
        Range("A1").EntireColumn.Insert
        Range("A1").Value = "DUPE_CHECK"
    Else
        Range("A2:A65000").Clear
    End If

'Finding the last row in the Column B
    lastRow = Range("B65000").End(xlUp).Row

'looping through the column B
    For iCntr = 1 To lastRow
        'checking if the cell is having any item, skipping if it is blank.
        If Cells(iCntr, 2) <> "" Then
            'getting match index number for the value of the cell
            matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
            'if the match index is not equals to current row number, then it is a duplicate value
            If iCntr <> matchFoundIndex Then
                'Printing the label in the column A
                Cells(iCntr, 1) = "Duplicate"
            End If
        End If
    Next

'auto fit column A
    Columns("A").AutoFit

End Sub

excel vba duplicate-data
person Chito    schedule 16.06.2015    source источник
comment
вы имеете в виду вместе с номером столбца, который дублируется? Правильно ли я понимаю, что когда B12 и C12 совпадают, вы хотите, чтобы A12 говорил B, C?   -  person h3n    schedule 17.06.2015
comment
Я имею в виду, что B50: D50 и B55: D55 такие же, как B2: D2, а затем скажите «Дублировать со строкой 2 в A50 и A55» (от B до D — первичный ключ, который будет определять дублирование).   -  person Chito    schedule 17.06.2015

Ответы (1)


arrow_upward
0
arrow_downward

Я попытался с простой конкатенацией, с которой я знаком, но до сих пор не могу понять, как добавить номер строки, и это немного медленно, дайте мне знать, как я могу улучшить приведенный ниже код и добавить дублирование номера строки.

Sub FindDuplicatesInColumn()
'Declaring the lastRow variable as Long to store the last row value in the Column1
    Dim lastRow As Long

'matchFoundIndex is to store the match index values of the given value
    Dim matchFoundIndex As Long

'iCntr is to loop through all the records in the column using For loop
    Dim iCntr As Long

'test the column A and insert a column or clear data
    If Range("A1").Value = "PDBC_PFX" Then
        Range("A1").EntireColumn.Insert
        Range("A1").EntireColumn.Insert
        Range("A1").Value = "DUPE_CHECK"
        Range("B1").Value = "KEY"
    ElseIf Range("B1").Value = "PDBC_PFX" Then
        Range("B1").EntireColumn.Insert
        Range("B1").Value = "KEY"
    Else
        Range("A2:B65000").Clear
    End If

'Finding the last row in the Column B
    lastRow = Range("C65000").End(xlUp).Row

'add a key for the columns to check
    Range("B2:B" & lastRow).FormulaR1C1 = "=RC[1]&RC[2]&RC[3]"
    Range("B:B").Value = Range("B:B").Value


'looping through the column B
    For iCntr = 1 To lastRow
        'checking if the cell is having any item, skipping if it is blank.
        If Cells(iCntr, 2) <> "" Then
            'getting match index number for the value of the cell
            matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
            'if the match index is not equals to current row number, then it is a duplicate value
            If iCntr <> matchFoundIndex Then
                'Printing the label in the column A
                Cells(iCntr, 1) = "Duplicate"
            End If
        End If
    Next

'auto fit column A
    Columns("A").AutoFit

'remove key column after validation
    Columns("B").Delete

End Sub
person Chito    schedule 17.06.2015