Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Готовые решения

МЕНЮ САЙТА
  • 1
  • 2
  • 3

КАТЕГОРИИ РАЗДЕЛА

ОПРОСЫ
Какой версией Excel Вы пользуетесь?
Всего ответов: 35767
Главная » Готовые решения » VBA » Полезные приёмы

Копирование только уникальных значений без сортировки
23.04.2016, 21:25
[ Файл-пример (17.5Kb) ]

Процедура копирует только уникальные значения из одного столбца без использования метода 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

Добавил: StoTisteg | | Теги: VBA
Просмотров: 307 | Рейтинг: 0.0/0
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!