Set MyCollection = New Collection On Error Resume Next For Each Cell In Rng.Cells MyCollection.Add Cell.Value, CStr(Cell.Value) Next Cell Next i On Error GoTo 0 For Each vNum In MyCollection MsgBox vNum On Error Resume Next
Next vNum
End Sub
[/vba]
Спасибо.
Добрый вечер всем Подскажите, пожалуйста, как добавить в коллекцию то, что выделено серым в примере
Отталкиваюсь от этого, но не получается.
[vba]
Код
Sub U()
Dim Msg As String Dim Response As Long Dim MyCollection As Collection Dim Rng As Range Dim Cell As Range Dim vNum As Variant Dim i&
Set MyCollection = New Collection On Error Resume Next For Each Cell In Rng.Cells MyCollection.Add Cell.Value, CStr(Cell.Value) Next Cell Next i On Error GoTo 0 For Each vNum In MyCollection MsgBox vNum On Error Resume Next
Dim Msg As String Dim Response As Long Dim MyCollection As Collection Dim Rng As Range Dim Cell As Range Dim vNum As Variant Dim i&
lr1 = Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row + 1 lr2 = Sheets("Лист1").Cells(Rows.Count, 2).End(xlUp).Row - 1 Set Rng = Range(Cells(lr1, "J"), Cells(lr2, "J")) Set MyCollection = New Collection On Error Resume Next For Each Cell In Rng.Cells MyCollection.Add Cell.Value, CStr(Cell.Value) Next Cell 'Next i On Error GoTo 0 For Each vNum In MyCollection MsgBox vNum 'On Error Resume Next Next vNum
End Sub
[/vba]
[vba]
Код
Sub U()
Dim Msg As String Dim Response As Long Dim MyCollection As Collection Dim Rng As Range Dim Cell As Range Dim vNum As Variant Dim i&
lr1 = Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row + 1 lr2 = Sheets("Лист1").Cells(Rows.Count, 2).End(xlUp).Row - 1 Set Rng = Range(Cells(lr1, "J"), Cells(lr2, "J")) Set MyCollection = New Collection On Error Resume Next For Each Cell In Rng.Cells MyCollection.Add Cell.Value, CStr(Cell.Value) Next Cell 'Next i On Error GoTo 0 For Each vNum In MyCollection MsgBox vNum 'On Error Resume Next Next vNum