Здравствуйте. Возможно ли сохранение VBA-коллекции на лист за один проход. Также как с массивами. Считывать циклом и записывать элемент в каждую ячейку - долго. Как записать оптом всю коллекцию ?
Код
Sub СборкаМатериалов210921()
Dim KM As New Collection 'коллекция материалов
Set arr = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
On Error Resume Next
For Each i In arr
KM.Add i.Value, CStr(i.Value)
Next i
On Error GoTo 0
' далее нужно сохранить всю коллекцию на лист за один проход, (также быстро как можно сохранять массивы)
' т.е. без записи каждой отдельной ячейки
End Sub
Sub СборкаМатериалов220921()
Dim KM As Object
Set KM = CreateObject("Scripting.Dictionary")
Dim arr As Variant
Set arr = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
On Error Resume Next
For Each i In arr
KM.Add KM.Count, CStr(i.Value)
Next i
On Error GoTo 0
Range("A1").Resize(KM.Count, 1) = Application.Transpose(KM.Items())
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
выгружать нужно КЛЮЧИ, а не ЗНАЧЕНИЯ— иначе зачем это всё? В коллекциях пара инвертирована и представляет собой ЗНАЧЕНИЕ-КЛЮЧ, а не привычное по логике и словарям КЛЮЧ-ЗНАЧЕНИЕ (если вы руководствовались этим)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
У ТС в первом сообщении коллекция наполняется таким образом, что возможны повторы. Для того, чтобы сохранить эту возможность, сделал выгрузку значений.
МатросНаЗебре: У ТС в первом сообщении коллекция наполняется таким образом, что возможны повторы
ещё раз перечитайте моё замечание У ТСа в качестве И КЛЮЧЕЙ, И ЗНАЧЕНИЙ — ОДНИ И ТЕ ЖЕ данные, поэтому непонятно, откуда такой вывод… Выставление оператора On Error Resume Next однозначно говорит, что мы готовимся к ошибкам при добавлении повторов ключей, а значит отбираем УНИКАЛЬНЫЕ причём совершенно хрестоматийным способом
О ключах коллекции
Удивлюсь, если ТС не согласен со мной
Изменено: Jack Famous - 21.09.2021 09:52:00(Добавил скрин)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
МатросНаЗебре написал: в первом сообщении коллекция наполняется таким образом, что возможны повторы
это в каком месте, если не секрет? Что-то не углядел подобного. О повторах чего речь? Там и для ключа и для значения - одна и та же ячейка используется. Только для ключа всегда в текст переводится, а для значения - нет. Этот подход позволяет как раз избежать таких задвоений как: 1 <> "1".
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Подскажите плиз. Перезаписываю циклом коллекцию в массив.
Пытаюсь массив выгрузить на лист, а выгружается только первый элемент. Чего делаю не так ?
Код
Sub СборкаМатериалов210921()
Dim KM As New Collection 'коллекция материалов
Dim arr() As Variant
Set a = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
On Error Resume Next
For Each i In a
KM.Add i.Value, CStr(i.Value)
Next i
On Error GoTo 0
ReDim arr(1 To KM.Count)
For r = 1 To KM.Count
arr(r) = KM(r)
Next
Range("B1").Resize(UBound(arr, 1), 1) = arr
End Sub
одномерный массив не выгрузить в столбец (можно в строку или с помощью транспонирования) Исправьте ReDim arr(1 To KM.Count, 1 To 1)
Как бы я сделал (без словарей и за 1 цикл)
Код
Sub СборкаМатериалов210921()
Dim KM As New Collection
Dim x, aAll, aOut(), r&
aAll = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
ReDim aOut(1 To UBound(aAll, 1), 1 To 1)
On Error Resume Next
For Each x In aAll
KM.Add 0, CStr(x)
If Err Then
Err.Clear
Else
r = r + 1: aOut(r, 1) = x
End If
Next x
On Error GoTo 0
Range("B1").Resize(r, 1) = aOut
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄