Добрый день!
Подскажите, пожалуйста, что не так в прилагаемой процедуре? Коллекция из уникальных значений формируется правильно, массив из тех же значений - тоже правильно, но при вставке я получаю только первый элемент массива в каждой ячейке. При вставке я избегал цикла, как рекомендует Уокенбах, но у него в примере данные из массива в диапазон переносятся правильно, а у меня нет.
Буду благодарен за помощь.
Подскажите, пожалуйста, что не так в прилагаемой процедуре? Коллекция из уникальных значений формируется правильно, массив из тех же значений - тоже правильно, но при вставке я получаю только первый элемент массива в каждой ячейке. При вставке я избегал цикла, как рекомендует Уокенбах, но у него в примере данные из массива в диапазон переносятся правильно, а у меня нет.
Буду благодарен за помощь.
| Код |
|---|
Sub CopyPasteUnique()
'процедура формируем массив уникальных значений в выбранном диапазоне и вставляем его в указанную ячейку
Dim cell As Range
Dim Unique As New Collection
Dim cellPaste As Range
Dim i As Long
Dim UniqueArray()
If TypeName(Selection) <> "Range" Then
Exit Sub
End If
On Error Resume Next
'запрашиваем у пользователя ячейку для вставки
Set cellPaste = Application.InputBox("Укажите ячейку для вставки", Type:=8)
On Error GoTo 0
If cellPaste Is Nothing Then
Exit Sub
End If
Set cellPaste = cellPaste.Range("A1")
On Error Resume Next
For Each cell In Selection
'формируем коллекцию из уникальных значений диапазона
If cell.Value <> "" Then
Unique.Add cell.Value, CStr(cell.Value)
End If
Next cell
On Error GoTo 0
ReDim UniqueArray(1 To Unique.Count)
'переносим уникальные значения в массив
For i = 1 To Unique.Count
UniqueArray(i) = Unique.Item(i)
Next i
'определяем диапазон для вставки
Set cellPaste = Range(cellPaste, cellPaste.Offset(Unique.Count - 1, 0))
'вставляем массив в диапазон
' при вставке я пытался избежать цыкла (рекомендация одного автора учебника по VBA с примером).
' во всем диапазоне для вставки я получаю только первое значание массива
cellPaste.Value = UniqueArray
End Sub |
