Процедура копирует только уникальные значения из одного столбца без использования метода RemoveDuplicates, сортировки и дополнительных листов и столбцов

При необходимости копирования только уникальных значений из одного из столбцов может, однако, быть неприемлемым применение метода RemoveDuplicates. Применение AdvancedFilter неудобно из-за необходимости создания дополнительных столбцов с последующим их удалением. Для копирования прямо в целевой столбец можер использовать метод Find, копируя повторяющиеся значения в те ячейки, где они и так уже есть, а уникальные — вниз столбца. Примечание. Метод довольно медленный, поскольку перебирает все ячейки копируемого столбца последовательно, поэтому при большом количестве строк (больше нескольких сотен) имеет смысл всё же прибегнуть к AdvancedFilter



Данный пример копирует уникальные значения из 3-го столбца (константа InCol активного листа в первый столбец (константа OutCol) Листа2.



Public Const InCol As Integer = 3

Public Const OutCol As Integer = 1



Sub UniqueCopy()



Dim i As Integer



With Worksheets(2)

Cells(1, InCol).Copy Destination:=.Cells(1, OutCol)

For i = 2 To Cells(Rows.Count, InCol).End(xlUp).Row

On Error Resume Next

Cells(i, InCol).Copy Destination:=.Columns(OutCol).Find(what:=Cells(i, InCol).Value, lookat:=xlWhole)

If Err.Number <> 0 Then Cells(i, InCol).Copy Destination:=.Cells(.Cells(Rows.Count, OutCol).End(xlUp).Row + 1, OutCol)

Next i

End With



End Sub