Передать массив в ParamArray

Question

Можно ли передать все элементы массива в ParamArray?

Например, я хотел бы передать ParamArray другому ParamArray:

Sub test()
    p1 "test", "banane", "birne"
End Sub

Sub p1(ParamArray keys() As Variant)
    p2 keys 'should be the same as: p2 "test", "banane", "birne"
End Sub

Sub p2(ParamArray keys() As Variant)
    Dim key As Variant
    For Each key In keys
        Debug.Print key 'Run-time error '13' Type mismatch (key is an array)
    Next key
End Sub

В этом случае ParamArray of p2 не содержит элементов keys, но он получает массив-объект keys, Таким образом, я должен проверить, переданы ли массивы:

Sub test()
    p1 "test", "banane", "birne"
    p2 "test", "banane", "birne"
End Sub

Sub p1(ParamArray keys() As Variant)
    p2 keys
End Sub

Sub p2(ParamArray params() As Variant)
    Dim keys As Variant
    If IsArray(params(0)) Then
        keys = params(0)
    Else
        keys = params
    End If

    Dim key As Variant
    For Each key In keys
        Debug.Print key
    Next key
End Sub

Но это неудобно, например, по сравнению с Java:

public class VarArgs {

    public static void main(String[] args) {
        p1("test", "banane", "birne");
        p2("test", "banane", "birne");

        String[] array = {"test", "banane", "birne"};
        p1(array);
        p2(array);
    }

    public static void p1(String... strings) {
        p2(strings);
    }

    public static void p2(String... strings) {
        for (String string : strings) {
            System.out.println(string);
        }
    }

}

В Java я не должен различать. Но это, вероятно, невозможно в VBA.

Спасибо за помощь,
Майкл

Answer 1

Передайте аргумент ParamArray другой функции, которая ожидает аргумент ParamArray (делегируйте аргументы ParamArray). Мне нужно делегировать функции типа: strf(str as string, ParamArray args() as Variant) as String аргументы, полученные в другой функции в ParamArray, передаются напрямую без явной записи. Я нашел следующие ограничения:

1. ParamArray() может быть передан только другой функции, которая ожидает ParamArray.
2. ParamArray получен в элементе 0 как Variant ()
3. Когда вторая функция получает, она увеличивает уровень глубины. Я не нашел удовлетворительного решения, но я написал функцию, которая отлично работает, отменяя добавленные уровни глубины и возвращая вектор с полученными аргументами.

Код:

Option Explicit
Option Base 1

Public Sub PrAr1(ParamArray pa1() As Variant)
Dim arr() As Variant
  arr = fn.ParamArrayDelegated(pa1)
  PrAr2 pa1
End Sub

Public Sub PrAr2(ParamArray pa2() As Variant)
Dim i As Integer, arrPrms() As Variant
  arrPrms = fn.ParamArrayDelegated(pa2)
  For i = 0 To UBound(arrPrms)
    Debug.Print s.strf("i: %0 prm: %1 ", i, arrPrms(i))
  Next i
  PrAr3 pa2
End Sub

Public Sub PrAr3(ParamArray pa3() As Variant)
Dim i As Integer, arrPrms() As Variant
  arrPrms = fn.ParamArrayDelegated(pa3)
  For i = 0 To UBound(arrPrms)
    Debug.Print s.strf("i: %0 prm: %1 ", i, arrPrms(i))
  Next i
End Sub

Public Function ParamArrayDelegated(ParamArray prms() As Variant) As Variant
Dim arrPrms() As Variant, arrWrk() As Variant
'When prms(0) is Array, supposed is delegated from another function
  arrPrms = prms
  Do While VarType(arrPrms(0)) >= vbArray And UBound(arrPrms) < 1
    arrWrk = arrPrms(0)
    arrPrms = arrWrk
  Loop
  ParamArrayDelegated = arrPrms
End Function

Answer 2

Вы могли бы преобразовать его в Variant со 2-го захода на:

Sub test()
    p1 "test", "banane", "birne"
End Sub

Sub p1(ParamArray keys() As Variant)
    p2 CVar(keys) '<--| pass it as a Variant
End Sub

Sub p2(keys As Variant) '<--| accept a Variant argument
    Dim key As Variant

    For Each key In keys
        Debug.Print key
    Next key
End Sub

Answer 3

Вот мое решение. Обратите внимание, что его единственным ограничением является то, что вы можете передавать только один (Variant) аргумент массива в набор параметров ParamArray. Возможно, это можно было бы обобщить для обработки нескольких переданных массивов, но я еще не столкнулся с этой необходимостью.

Option Explicit

Sub test()
    p1 "test", "banane", "birne"
    p2 "test", "banane", "birne"
End Sub


Sub p1(ParamArray keys() As Variant)
    Dim TempKeys As Variant

    TempKeys = keys 'ParamArray isn't actually a standard Variant array, so you have to copy
                    'it to one in order for the added test/workaround in p2 to not crash
                    'Excel.

    p2 TempKeys 'should be the same as: p2 "test", "banane", "birne"
End Sub

Sub p2(ParamArray keys() As Variant)
    Dim key As Variant

    If IsArray(keys(0)) Then keys = keys(0) 'Set this routine's ParamArray parameter to be
                                            'the array of its first element.

    For Each key In keys
        Debug.Print key
    Next key
End Sub

Answer 4

Пытаться:

Sub p2(ParamArray keys() As Variant) 
dim myKey as Variant  
 If IsArray(keys(0)) Then
        myKey = keys(0)
    Else
        myKey = keys()
 End If

...
end sub

Answer 5

Чтобы передать вариант ParamArray из функции в функцию, вызываемую из самого Excel, принцип распаковки, показанный в предыдущих сообщениях @JoséIborraBotia, работал для списка диапазонов, но перехватывал исключение, возникающее при попытке распаковать один уровень слишком много вместо

тестирование VarType, UBound or IsArrayкак предлагалось ранее,

позволяет также работать для одного диапазона, ведь это важно при передаче выборок Excel в пользовательскую функцию.

Давайте найдем эту функцию распаковки вместе с демонстрацией ее использования для подсчета любой комбинации выбора ячеек Excel:

Функция распаковки ParamArray:

      Public Function unboxPA(ParamArray prms() As Variant) As Variant
    Dim arrPrms() As Variant, arrWrk() As Variant
    Dim done As Boolean
    done = False
    arrPrms = prms
    Do While Not done
        On Error Resume Next
          arrWrk = arrPrms(0)
        If (Err.Number > 0) Then
          done = True
        End If
        arrPrms = arrWrk
    Loop
    unboxPA = arrPrms
End Function

Распаковка используется для подсчета любого выбора ячеек excel:

      Function MyCountLargeCellsPA(ParamArray rangeArray() As Variant)
    Dim unboxed() As Variant
    unboxed = unboxPA(rangeArray)
    Dim n As Long
    For n = LBound(unboxed) To UBound(unboxed)
        MyCountLargeCellsPA = MyCountLargeCellsPA + unboxed(n).CountLarge
    Next
End Function

Это позволяет любому вложенному вызову функции использовать ParamArray,

Теперь можно программировать с помощью VBA!

Answer 6

Это больше не поможет ОП, поскольку вопрос был задан 10 лет назад в 2013 году.

Однако, если кто-то столкнется с этой проблемой, пожалуйста, не реализуйте такие ужасные вещи, которые разрушают логику кода (и производительность), как это предлагается в большинстве ответов. Просто напишите чистый код, чтобы обойти эту проблему.

Если вы действительно хотитеParamArray, затем сделайте это в общедоступном интерфейсе и преобразуйте его в обычныйArray. Позвольте реализации сделать все прямолинейно.

      Option Explicit

Public Sub test()
    p1 "test", "banane", "birne"
    p2 "test", "banane", "birne"
    p3 "test", "banane", "birne"
End Sub


'public interface

Public Sub p1(ParamArray keys() As Variant)
    Dim keys_() As Variant: keys_ = keys
    p1V keys_
End Sub

Public Sub p2(ParamArray keys() As Variant)
    Dim keys_() As Variant: keys_ = keys
    p2V keys_
End Sub

Public Sub p3(ParamArray keys() As Variant)
    Dim keys_() As Variant: keys_ = keys
    p3V keys_
End Sub


'private (or even public) implementation

Private Sub p1V(keys() As Variant)
    p2V keys
End Sub

Private Sub p2V(keys() As Variant)
    p3V keys
End Sub

Private Sub p3V(keys() As Variant)
    Dim key As Variant
    For Each key In keys
        Debug.Print key
    Next key
    ' "test", "banane", "birne"
    ' no matter which cascaded function was called
End Sub

Answer 7

Sub test()
    p1 "test", "banane", "birne"
End Sub

Sub p1(ParamArray keys() As Variant)
    p2 keys
End Sub

Sub p2(ParamArray keys() As Variant)
    Dim key As Variant
    For Each key In keys
        Debug.Print key(0) '<- Give an Index here.
    Next key
End Sub

Answer 8

Одна из моих самых сильных потребностей состоит в том, чтобы быть в состоянии принять ParamArray values() As Variantи превратил его в .

В соответствии с вопросом ОП мне также нужно иметь возможность перенаправлять другие функции на эту функцию, где другие функции имеют ParamArrayкоторый также необходимо преобразовать в String()прежде чем эта функция сможет продолжить работу.

Вот решение, которое включает в себя надежную функцию для безопасного возврата размера массива:

      Public Function f_uas_astrFromParamArray( _
    ParamArray pr_avarValues() As Variant _
) As String()
  Dim astrResult() As String
  
  Dim avarTemp() As Variant
  Dim lngSize As Long
  Dim lngUBound As Long
  Dim lngIndex As Long
  
  If (IsMissing(pr_avarValues) = False) Then
    If (IsArray(pr_avarValues(0)) = True) Then
      avarTemp = pr_avarValues(0)
    Else
      avarTemp = pr_avarValues
    End If
    lngSize = f_lngArraySize(avarTemp)
    If (lngSize > 0) Then
      lngUBound = lngSize - 1
      ReDim astrResult(0 To lngUBound)
      For lngIndex = 0 To lngUBound
        astrResult(lngIndex) = CStr(avarTemp(lngIndex))
      Next lngIndex
    End If
  End If
  
  f_uas_astrFromParamArray = astrResult
End Function

'Return Value:
'   -1 - Not an Array
'    0 - Empty
'  > 0 - Defined
Public Function f_ua_lngArraySize( _
    ByRef pr_avarValues As Variant _
  , Optional ByVal pv_lngDimensionOneBased As Long = 1 _
) As Long
  Dim lngSize As Long: lngSize = -1 'Default to not an Array
  Dim lngLBound As Long
  Dim lngUBound As Long
  
  On Error GoTo Recovery
  
  If (IsArray(pr_avarValues) = True) Then
    lngSize = 0 'Move default to Empty
    lngLBound = LBound(pr_avarValues, pv_lngDimensionOneBased)
    lngUBound = UBound(pr_avarValues, pv_lngDimensionOneBased)
    If (lngLBound <= lngUBound) Then
      lngSize = lngUBound - lngLBound + 1 'Non-Empty, so return size
    End If
  End If
  
NormalExit:
  f_ua_lngArraySize = lngSize
  Exit Function
  
Recovery:
  GoTo NormalExit
End Function

Answer 9

ParamArrays странные, но вы можете использовать обычный Array, который прекрасно работает

 Sub test()
    Dim a As Variant: a = Array("test", "banane", "birne")
    p1 a
End Sub

Sub p1(keys As Variant)
    p2 keys
End Sub

Sub p2(keys As Variant)
    Dim key As Variant
    For Each key In keys
        Debug.Print key
    Next key
End Sub