Здравствуйте господа. Возникла необходимость найти все уникальные значения в диапазоне и вывести все эти значения в одну ячейку текстовой строкой. Нашел на одном из сайтов небольшой макрос для поиска уникальных значений. Вот тело макроса:
На этом же листе в ячейку A1 требуется вписать строковое выражение - что-то по типу
Range ("A1"). Value = "Найдены следующие договоры:" &"№"& myElement "," + 1
То есть требуется из коллекции myCollection взять (перебрать) все уникальные значения myElement и поместить их в текстовую строку в ячейку A1 по шаблону указанному выше.
Прошу оказать посильную помощь в доработке макроса.
Код |
---|
Sub ОтборУникальных() 'Объявляем переменные 'myRange - диапазон ячеек, заполненный исходным списком элементов 'myCell - отдельная ячейка диапазона 'myCollection - коллекция 'myElement - элемент коллекции (должен быть типа "Variant") Dim myRange As Range, myCell As Range, myCollection As New Collection, _ myElement As Variant, i As Long 'присваиваем переменной myRange диапазон ячеек с исходным списком элементов Set myRange = Range("B2:B29") 'заполняем новую коллекцию уникальными элементами On Error Resume Next For Each myCell In myRange myCollection.Add CStr(myCell.Value), CStr(myCell.Value) Next myCell On Error GoTo 0 |
Range ("A1"). Value = "Найдены следующие договоры:" &"№"& myElement "," + 1
То есть требуется из коллекции myCollection взять (перебрать) все уникальные значения myElement и поместить их в текстовую строку в ячейку A1 по шаблону указанному выше.
Прошу оказать посильную помощь в доработке макроса.