将数组传递给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

在这种情况下，

p2

的ParamArray不包含

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

您可以从第二次调用开始将其转换为

Variant

：

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 2

将 ParamArray 参数传递给另一个需要 ParamArray 参数的函数（委托 ParamArray 参数）。我需要委托给以下类型的函数：

strf(str as string, ParamArray args() as Variant) as String

在 ParamArray 中的其他函数中接收的参数直接传递，无需显式写入。我发现的限制是：

ParamArray() 它只能传递给另一个需要 ParamArray 的函数。
ParamArray 在元素 0 处作为 Variant () 接收
当第二个函数接收时，它会增加深度我还没有找到任何令人满意的解决方案，但我已经编写了一个完美运行的函数，撤消添加的深度级别并返回带有收到参数的向量。

代码：

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 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

这对OP不再有帮助，因为这个问题已经在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

变成

String()

。

根据OP问题，我还需要能够将其他函数转发到此函数，其中其他函数有一个

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 很奇怪，但你可以使用普通的数组，它工作得很好

 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

将数组传递给ParamArray

问题描述投票：0回答：9

9个回答

最新问题

将数组传递给ParamArray

问题描述 投票：0回答：9

9个回答

最新问题

问题描述投票：0回答：9