Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA Вернуть диапазон в список
 
#1
04.06.2018 14:11:07
Добрый день, уважаемые форумчане!
Пробую создать функцию на vba, которая будет неким аналогом ВПР, но выдавать сразу диапазон значений. Саму функцию не планирую использовать отдельно, только как аргумент для другой функции или в списке.

Как я себе представляю работу функции:
Diapason(table as range; znachenie as variant; nomer1 as byte; nomer2 as byte) as Range
Функция берет таблицу, в столбце1(nomer1) ищет искомое значение, если совпадает, то выдает адрес на ячейку из столбца2.
Столбец1 отфильтрован.
Хочу, чтобы вставив в список следующую формулу, мне выдавало 5-10, 11-15, 16-20
Diapason(именованнаятаблица; "яблоко"; 1; 2)

У меня получилось считать количество повторений значений, а также найти первое значение. Но что делать дальше я не понимаю.
Код
Option Base 1
Function diapason(table As Range, znachenie As String, nomer1 As Byte, nomer2 As Byte) As Range
Dim a As Byte
a = table.Rows.Count
Dim b As Byte, d As Byte
b = 0: d = 0

Dim i As Byte
For i = 1 To a
    If table(i, nomer1) = znachenie And b = 0 Then b = i
    If table(i, nomer1) = znachenie Then d = d + 1
    If table(i, nomer1) <> znachenie And d > 0 Then Exit For
Next i

diapason = ???
End Function
 
 
 
#2
04.06.2018 14:23:32
Код
Function diapason(table As Range, znachenie$, nomer1&, nomer2&)
Dim arr(), I&
arr = table
For I = 1 To UBound(arr)
    If arr(I, nomer1) = znachenie Then
        diapason = IIf(diapason <> Empty, diapason & ", " & arr(I, nomer2), arr(I, nomer2))
    End If
Next
End Function
Изменено: Sanja - 04.06.2018 14:24:33
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
04.06.2018 14:49:51
Не совсем то.  
Функция diapason должна выдавать диапазон с ячейками из второго столбца.  Это нужно чтобы дальше возможно было эту функцию использовать в качестве аргумента для другой функции. Тут просто перечисление значений через запятую.
Вопрос собственно в том, как вернуть диапазон ячеек.
К примеру: я могу в список написать =ИНДЕКС(ДВССЫЛ(Именнованнаятаблица);0;1) и в списке будет диапазон ячеек на выбор, состоящий из первого столбца именованной таблицы.

Может я неправильно объясняю..
Изменено: shtirlic39 - 04.06.2018 15:06:59
 
 
 
#4
04.06.2018 15:25:51
Цитата
shtirlic39 написал: Может я неправильно объясняю..
Я исходил из этого
Цитата
shtirlic39 написал: Хочу, чтобы вставив в список следующую формулу, мне выдавало 5-10, 11-15, 16-20
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
04.06.2018 15:28:44
Блин. Значит не верно написал.
имел в виду, что будет создан список из трех элементов
5-10
11-15
16-20
 
 
 
#6
04.06.2018 15:32:47
А зачем этот огород из вложений UDF в другую функцию?
Вот, например, следующая UDF вернет Вам именно ДИАПАЗОН, но как Вы его хотите на листе использовать?
Код
Function MYRANGE(table As Range, znachenie, nomer1&, nomer2&) As Range
Dim cl As Range, I&
For Each cl In table.Columns(nomer1).Cells
    If cl.Value = znachenie Then
        If Not MYRANGE Is Nothing Then
            Set MYRANGE = Union(MYRANGE, Cells(cl.Row, table.Columns(nomer2).Column))
        Else
            Set MYRANGE = Cells(cl.Row, table.Columns(nomer2).Column)
        End If
    End If
Next
End Function
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
04.06.2018 15:44:49
Пытаюсь вникнуть. Кажется то, что нужно. Сейчас протестирую.
 
 
 
#8
04.06.2018 15:53:43
Спасибо большое.
Я половину выходного просидел и не смог сделать.
В список записать функцию не получилось(пишет указанный диапазон не найден), а в функцию получилось, чего я и добивался.
 
 
 
#9
04.06.2018 15:55:15
Цитата
shtirlic39 написал: имел в виду, что будет создан список из трех элементов
Может так? Вводить как ФОРМУЛУ МАССИВА!!!
Код
Function MYARRAY(table As Range, znachenie$, nomer1&, nomer2&)
Dim arr(), I&, N&
arr = table.Value
On Error Resume Next
ReDim arrNew$(Application.Caller.Rows.Count, 0)
For I = 1 To UBound(arr)
    If arr(I, nomer1) = znachenie Then
        arrNew(N, 0) = arr(I, nomer2)
        N = N + 1
    End If
Next
MYARRAY = arrNew
End Function
Согласие есть продукт при полном непротивлении сторон
 
 
 
#10
04.06.2018 16:30:27
Опять  о разном говорим)) Формула работала как массив и раньше.)))
Когда я говорил список - имел ввиду: данные-проверка данных-тип данных -список.
 
 
 
#11
04.06.2018 18:07:30
Ох. Еще один вопрос.
Функция перестает работать как только я в качестве аргумента table использую диапазон с другого листа. Выдает нули.(На листе 2 работает, на листе 3 уже нет).
Это можно как-нибудь исправить? Аргумент table может быть на любом листе...
Код
Function MYRANGE(table As Range, znachenie, nomer1&, nomer2&) As Range
Dim cl As Range, I&
For Each cl In table.Columns(nomer1).Cells
    If cl.Value = znachenie Then
        If Not MYRANGE Is Nothing Then
            Set MYRANGE = Union(MYRANGE, Cells(cl.Row, table.Columns(nomer2).Column))
        Else
            Set MYRANGE = Cells(cl.Row, table.Columns(nomer2).Column)
        End If
    End If
Next
End Function
Изменено: shtirlic39 - 04.06.2018 18:22:24
 
 
 
#12
04.06.2018 19:24:01
Код
Function MYRANGE(table As Range, znachenie, nomer1&, nomer2&) As Range
Dim cl As Range, I&
With table.Parent
For Each cl In table.Columns(nomer1).Cells
    If cl.Value = znachenie Then
        If Not MYRANGE Is Nothing Then
            Set MYRANGE = Union(MYRANGE, .Cells(cl.Row, table.Columns(nomer2).Column))
        Else
            Set MYRANGE = .Cells(cl.Row, table.Columns(nomer2).Column)
        End If
    End If
Next
End With
End Function
Согласие есть продукт при полном непротивлении сторон
 
 
 
Страницы: 1
Наверх