Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA. получить Collection из Функции, Функция формирует коллекцию. Необходимо получить результат работы функции (т.е. получить Коллекцию)
 
#1
09.04.2019 23:06:07
есть такой код (см ниже)
не пойму как в Подпрограмме Sub test() получить коллекцию сформированную функцией Function create_collection
объясните, пожалуйста, что не так.
Код
Sub test()Dim a As New Collection

Set a = create_collection("Sales", "E")
MsgBox a.Count

End Sub
Код
Function create_collection(ByVal page As String, ByVal column As String) As Collection  ' формирование массива уникальных элементов
 
'Объявляем переменные
'myRange - диапазон ячеек, заполненный исходным списком элементов
'myCell - отдельная ячейка диапазона
Dim myRange As Range, myCell As Range, LastRow As Long

Sheets(page).Select
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

'присваиваем переменной myRange диапазон ячеек с исходным списком элементов
Set myRange = Sheets(page).Range(column & "2").Resize(LastRow - 1, 1)

'заполняем новую коллекцию уникальными элементами
On Error Resume Next
For Each myCell In myRange
create_collection.Add CStr(myCell.Value), CStr(myCell.Value)
Next myCell
On Error GoTo 0

End Function
 
 
 
#2
09.04.2019 23:28:14
Работает это:
Код
Option Explicit

Sub test()
    Dim a As New Collection

    Set a = create_collection("Sales", "E")
    MsgBox a.Count

End Sub


Function create_collection(ByVal page As String, ByVal column As String) As Collection  ' формирование массива уникальных элементов

'Объявляем переменные
'myRange - диапазон ячеек, заполненный исходным списком элементов
'myCell - отдельная ячейка диапазона
    Dim myRange As Range, myCell As Range, LastRow As Long, c As New Collection

    Sheets(page).Select
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row

    'присваиваем переменной myRange диапазон ячеек с исходным списком элементов
    Set myRange = Sheets(page).Range(column & "2").Resize(LastRow - 1, 1)

    'заполняем новую коллекцию уникальными элементами
    On Error Resume Next
    For Each myCell In myRange
        c.Add CStr(myCell.Value), CStr(myCell.Value)
    Next myCell
    On Error GoTo 0
    Set create_collection = c
End Function

Но недочётов тут уйма, исправлять некогда...
А по сути вопроса - если бы Ваша функция создавала коллекцию - Вы бы её и получили в подпрограмму (почему под?), так что там всё ОК...
 
 
 
#3
09.04.2019 23:34:46
Код
Sub test()
  Dim a
  Set a = create_collection("Sales", "E")
  MsgBox a.Count
End Sub

Function create_collection(ByVal page As String, ByVal column As String) As Collection
  Dim myRange As Range, myCell As Range, LastRow As Long
  Set create_collection = New Collection
  Sheets(page).Select
  LastRow = Cells(Rows.Count, Range(column & 1).column).End(xlUp).Row
  Set myRange = Sheets(page).Range(column & "2").Resize(LastRow - 1, 1)
  On Error Resume Next
  For Each myCell In myRange
    create_collection.Add CStr(myCell.Value), CStr(myCell.Value)
  Next myCell
  On Error GoTo 0
End Function
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#4
09.04.2019 23:36:21
Основная ошибка указана, а вот обработка ошибки On Error Resume Next усугубила, в результате ничего не происходило, но вы об этом не узнавали
По вопросам из тем форума, личку не читаю.
 
 
 
#5
10.04.2019 10:00:39
Спасибо всем кто помог.
получается основная ошибка была в отсутствии строки
Код
Set create_collection = New Collection
в теле функции.

странно, что она нужна, т.к. в мануале по Функциям читал что отдельно инициализировать возвращаемую переменную в Функции не требуется...
 
 
 
#6
10.04.2019 10:08:39
еще косяк был, вы в функцию передаете колонку Е, а последню строку ищете по колонке 1, не факт что в этих колонках будет одинаковое количество элементов, но Вам виднее никто из нас файла не видел  
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#7
10.04.2019 10:15:41
Цитата
Ігор Гончаренко написал:
колонку Е, а последню строку ищете по колонке 1
это не косяк, это структура данных такая, что длинна колонки 1 всегда равна длине передаваемой колонки. Но, вообще, согласен, что выглядит это криво в коде.
 
 
 
#8
10.04.2019 11:51:51
Цитата
sol ant написал:
странно, что она нужна
Ничего странного. Вы объявили тип объекта, возвращаемого функцией, но объект-то надо создать, т.е. слово New должно присутствовать в коде. Переменную Вы можете объявить ... As New Collection, а функцию так объявить не получается. Значит, приходится использовать оператор New.
 
 
 
#9
10.04.2019 12:21:01
Цитата
sol ant написал:
инициализировать возвращаемую переменную в Функции не требуется
Дополнение. Функция в #1 возвращает объект и инициализируется "значением" Nothing. Это же значение и возвращается, "благодаря" конструкции On error (o чем коллеги написали).
Выполнение макроса test из #1 эквивалентно следующему:
Код
Sub test()
 Dim a As New Collection
 Set a = Nothing
 MsgBox a.Count
End Sub
Казалось бы, функция Msgbox должна вызвать ошибку выполнения, но этого не происходит, ввиду конструкции "New" в описании (объект создается при первом обращении).
Изменено: sokol92 - 10.04.2019 12:46:06
Владимир
 
 
 
Страницы: 1
Наверх