Метод 1: цикл по ячейкам
Один простой подход заключается в циклическом просмотре каждой ячейки в выбранном столбце, сравнении ее значения со значениями в ячейках выше и ниже нее. Если найден дубликат, ячейку можно очистить или удалить. Вот пример того, как может выглядеть код:

Sub RemoveDuplicatesLoop()
    Dim currentCell As Range
    Dim selectedColumn As Range

    ' Get the selected column
    Set selectedColumn = Selection.EntireColumn

    ' Loop through each cell in the selected column
    For Each currentCell In selectedColumn.Cells
        ' Check if the current cell has a value and is not the selected cell
        If Not IsEmpty(currentCell) And currentCell.Address <> ActiveCell.Address Then
            ' Check if the value is repeated above or below
            If Application.WorksheetFunction.CountIf(selectedColumn, currentCell.Value) > 1 Then
                ' Clear the duplicate cell
                currentCell.ClearContents
                ' Or delete the entire row
                ' currentCell.EntireRow.Delete
            End If
        End If
    Next currentCell
End Sub

Метод 2: фильтрация и удаление
Другой метод предполагает использование функции автофильтра в Excel. Этот подход фильтрует выбранный столбец, чтобы отображать только дубликаты, а затем удаляет видимые ячейки. Вот пример:

Sub RemoveDuplicatesFilter()
    Dim selectedColumn As Range

    ' Get the selected column
    Set selectedColumn = Selection.EntireColumn

    ' Apply the AutoFilter to the selected column
    selectedColumn.AutoFilter Field:=1, Criteria1:="<>"

    ' Delete the visible cells (excluding the header)
    selectedColumn.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

    ' Turn off the AutoFilter
    selectedColumn.AutoFilter
End Sub

Метод 3: расширенный фильтр
Функция расширенного фильтра в Excel обеспечивает еще большую гибкость. Это позволяет извлекать уникальные значения в другое место, сохраняя при этом исходные данные. Вот пример:

Sub RemoveDuplicatesAdvancedFilter()
    Dim selectedColumn As Range
    Dim uniqueRange As Range

    ' Get the selected column
    Set selectedColumn = Selection.EntireColumn

    ' Set the range where the unique values will be extracted
    Set uniqueRange = Sheet2.Range("A1")

    ' Apply the Advanced Filter to the selected column
    selectedColumn.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=uniqueRange, Unique:=True

    ' Clear the original data
    selectedColumn.ClearContents
    ' Or delete the entire column
    ' selectedColumn.EntireColumn.Delete
End Sub

Имея в своем распоряжении эти три метода, вы можете попрощаться с дублированием данных в столбце, где находится выбранная ячейка. Предпочитаете ли вы перебирать ячейки, использовать функцию автофильтра или использовать возможности расширенного фильтра, макросы Excel VBA предлагают универсальные решения для оптимизации процесса очистки данных. Так что давайте, попробуйте эти макросы и наслаждайтесь удобной работой с Excel!