Как проверить наличие дубликатов в определенном столбце?

Question

Я пытаюсь обнаружить дубликаты в столбце ("G") моей входной рабочей книги и, используя последнюю строку своих данных в столбце ("E"), объединить вверх, используя & "" &, после чего он удалит всю строку и этот процесс продолжается до тех пор, пока больше не будет дубликатов.

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

Dim myCell As Range, myRow As Integer, myRange As Range, myCol As Integer, X As Integer

    'Count number column

Set wsInput = Workbooks("InputB.xls").Worksheets("HC_MODULAR_BOARD_20180112")

     myCol = Range(Cells(3, 7), Cells(3, 7).End(xlDown)).Count

     'Loop each column to check duplicate values & highlight them.

     For X = 3 To myRow
     Set myRange = Range(Cells(2, X), Cells(myRow, X))

     For Each myCell In myRange
     If Workbooks("InputB.xls").Worksheets("HC_MODULAR_BOARD_20180112").CountIf(myRange, myCell.Value) > 1 Then
     myCell.Interior.ColorIndex = 3

    End If
     Next
     Next


'  allow values at Column"E" to merge upwards and delete all duplicate and its row (missing)

Понятия не имею, как удалить после копирования данных в верхней части столбца. Кто-нибудь, пожалуйста, помогите.

Большое спасибо, Адриан

Answer 1

Вы можете попробовать:

Option Explicit

Sub test()

    Dim LastRow As Long, i As Long, y As Long, Counter As Long
    Dim SearchValue As String, AddValue As String

    With ThisWorkbook.Worksheets("Sheet1") ' Always select your worksheet name

        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        Counter = 0
        AddValue = ""
        SearchValue = ""

        For i = LastRow To 3 Step -1

            SearchValue = .Range("C" & i).Value

            If SearchValue <> "" Then

                If Application.WorksheetFunction.CountIf(.Range("C3:C" & LastRow), SearchValue) > 1 Then

                    For y = i To 3 Step -1

                        If .Range("C" & y).Value = SearchValue Then

                            If AddValue = "" Then
                                AddValue = .Range("E" & y).Value
                            Else
                                AddValue = AddValue & ", " & .Range("E" & y).Value
                                .Rows(y).EntireRow.Delete
                                Counter = Counter + 1
                            End If

                        End If

                    Next y

                    .Range("E" & i - Counter).Value = AddValue
                    AddValue = ""
                    SearchValue = ""
                    Counter = 0

                End If

            End If

        Next i

    End With

End Sub