функция, которая возвращает все j-ые элементы из данных элементов - PullRequest
Новая
       48

функция, которая возвращает все j-ые элементы из данных элементов

1 голос
/ 13 июня 2019

Я хочу написать функцию, которая возвращает все j-тые элементы заданных элементов. Элементы содержат отдельные ячейки, диапазоны ячеек или оба.

Хотя можно вернуть все элементы (test1), все первые элементы (test2), я не могу вернуть элементы каждую секунду (или выше).

С учетом таблицы Excel 

    B   C   D
2   X   1   333
3   X   2   666
4   Z   3   999

=test1((B2;C2;D2);B3:D3;(B4:C4;D4)) возвращает X 1 333 Y 2 666 Z 3 999

=test2((B2;C2;D2);B3:D3;(B4:C4;D4)) возвращает X Y Z

Но =test3((B2;C2;D2);B3:D3;(B4:C4;D4)) возвращает Y 2 3, что неверно. Должен вернуть 1 2 3.

enter image description here

Код VBA-функций следующий: 

Function Test1(ParamArray argArray() As Variant)
' return all elements of all items = OK
    For Each outer_arg In argArray
        For Each inner_arg In outer_arg
            Test1 = Test1 & " " & inner_arg
        Next inner_arg
    Next outer_arg
End Function

Function Test2(ParamArray argArray() As Variant)
' return only the 1st elemtent of each item = OK
    For Each outer_arg In argArray
        Test2 = Test2 & " " & outer_arg(1)
    Next outer_arg
End Function

Function Test3(ParamArray argArray() As Variant)
' return only the 2nd elemtent of each item = FAILS
    For Each outer_arg In argArray
        Test3 = Test3 & " " & outer_arg(2)
    Next outer_arg
End Function

Как правильно адресовать определенные элементы?

Ответы [ 3 ]

2 голосов
/ 13 июня 2019

Вы не можете надежно индексировать непосредственно в многосекторный диапазон (за исключением первой области).Например: 

? Range("B4:C4,D4")(3).address '>> B5, not D4 

? Range("B4,C4,D4")(2).address '>> B5, not C4

Вы можете использовать что-то вроде этого: 

Function GetNthCell(rng As Range, n As Long) As Range
    Dim i As Long, c As Range, a As Range, tCurr As Long, tPrev As Long
    For Each a In rng.Areas
        tCurr = a.Cells.Count
        If tPrev + tCurr >= n Then
            Set GetNthCell = a.Cells(n - tPrev)
            Exit Function
        End If
        tPrev = tPrev + tCurr
    Next a
End Function

Sub Test()
    Debug.Print GetNthCell(Range("a1:A5,B1:B5,C1"), 6).Address '>> B1
End Sub
0 голосов
/ 13 июня 2019

Спасибо @TimWilliams за то, что показали мне, что я неправильно понял, и что это за угловой регистр (отдельные диапазоны). Я написал решение, которое перебирает все элементы простым счетчиком. У меня работает.

enter image description here

Function Test4(nmbr, ParamArray argArray() As Variant)
' return only the j-th argument (nmbr) of each element = OK

    For Each outer_arg In argArray
        cnt = 1
        For Each inner_arg In outer_arg
            If cnt = nmbr Then
                Test4 = Test4 & " " & inner_arg.Value
            End If
            cnt = cnt + 1
        Next inner_arg
    Next outer_arg
End Function
0 голосов
/ 13 июня 2019

попробуйте это и изучите это 

Function Test2(ParamArray argArray() As Variant)
' return all elements of all items = OK
    For Each outer_arg In argArray
        For Each inner_arg In outer_arg(1, 1)
            Test2 = Test2 & " " & inner_arg
        Next inner_arg
    Next outer_arg
End Function

Function Test3(ParamArray argArray() As Variant)
' return all elements of all items = OK
    For Each outer_arg In argArray
        For Each inner_arg In outer_arg(1, 2)
            Test3 = Test3 & " " & inner_arg
        Next inner_arg
    Next outer_arg
End Function
...