UDF中的动态vars数量

时间:2017-11-21 11:05:36

标签: arrays vba excel-vba dynamic dynamic-variables

我正在编写一个UDF,试图用未排序的"矩阵" /字符串和数字数组创建一个列表。我只想列出非数字。到目前为止,我已经解决了所有问题。但现在我正在努力实现"动态数量的输入变量。我希望能够标记几个单独的矩阵/数组。

解释到目前为止发生的事情:

UDF被称为" LIST"它有3个inputvars :( SearchRange As Range,ExceptionRange As Range,OnlyStrings As Boolean)

SearchRange是我正在收集我的数据的范围,ExceptionRange是异常应该忽略的val(我必须实现它,否则我总是得到相同的字符串。)而且,正如名称所示,OnlyStrings是布尔值,用于决定是否要在评估过程中考虑数字。

函数调用的示例:=LIST($C$2:$N$73;$C$75:C75;TRUE)

这是我的UDF代码:

Public Function LIST(SearchRange As Range, ExceptionRange As Range, OnlyStrings As Boolean)

    'Assign value to LIST as default val
    LIST = "Nothing found."
    'If an error occurs express the error with its val
    On Error GoTo ERRORHANDLING
    Dim codeoferror As String
    codeoferror = "01"
    '"Consts"
    Dim FstRow As Integer, FstCol As Integer, _
        LstRow As Integer, LstCol As Integer
    'Loop Vars
    Dim CurRow As Integer, CurCol As Integer, i As Integer, j As Integer
    'Initiate Arr
    Dim ExcArr() As String
    ReDim ExcArr(1 To 1) As String
    ExcArr(1) = ""

    'Create Array with all Vals of ExceptionRange
    codeoferror = "02"
    For i = ExceptionRange.Row To (ExceptionRange.Row + _
            ExceptionRange.Rows.Count - 1)
        For j = ExceptionRange.Column To (ExceptionRange.Column + _
                ExceptionRange.Columns.Count - 1)
            ReDim Preserve ExcArr(1 To UBound(ExcArr) + 1)
            ExcArr(UBound(ExcArr)) = Cells(i, j)
        Next j
    Next i

    'Assigning Vals to "Consts"
    codeoferror = "03"
    FstRow = SearchRange.Row
    FstCol = SearchRange.Column
    LstRow = SearchRange.Row + SearchRange.Rows.Count - 1
    LstCol = SearchRange.Column + SearchRange.Columns.Count - 1

    'Going through SearchRange searching for Non-Numerics
    For CurRow = FstRow To LstRow
        For CurCol = FstCol To LstCol
            If IsNumeric(Cells(CurRow, CurCol)) <> OnlyStrings Then
                'Jump to "ISINARRAY" (to replace an additional function)
                GoTo ISITINARRAY
ISINARRAY:
            End If
        Next CurCol
    Next CurRow
    GoTo FUNCTIONEND

    'As a replacement for an additional Func
    codeoferror = "04"
ISITINARRAY:
    For i = LBound(ExcArr) To UBound(ExcArr)
        If ExcArr(i) = Cells(CurRow, CurCol) Then GoTo ISINARRAY
    Next i
    LIST = Cells(CurRow, CurCol)
    GoTo FUNCTIONEND

    'Errorhandling
ERRORHANDLING:
    LIST = "ERROR VBA" & codeoferror

    'End of Function (and its Marker)
FUNCTIONEND:
End Function

我知道GOTO非常糟糕。它必须工作,到目前为止它的工作。

所以,如果我想考虑的不只是一个数组作为我的SearchRange的输入,我该如何动态地做到这一点?

解答:

所以,休息一下后,我终于设法得到了我正在寻找的UDF。 ParamArray确实是一个巨大的帮助。现在我认为它是必要的,列表在一列中。所以我能够用一个名为&#34; Heading&#34;的新val替换ExceptionRange。 - 代表我的清单标题。这导致单元格中的以下函数调用:

 =LIST2("benötigt" ;TRUE           ;$C$2:$N$73;$A$2:$A$73)  
'=LIST2(*_Heading_*;*_OnlyStrings_*;*_SearchRange_*      )

这是我的代码:

Public Function LIST2(ByVal Heading As String, _
                      ByVal OnlyStrings As Boolean, _
                      ParamArray SearchRange() As Variant)

    'LIST2 only works written in one column, else no functionality

    'Assign value to LIST2 as default val
    LIST2 = "Nothing found."
    'If an error occurs express the error with its val
    On Error GoTo ERRORHANDLING
    Dim codeoferror As String
    codeoferror = "01 - error while initiation"
    '"Consts"
    Dim FstRow As Integer, FstCol As Integer, LstRow As Integer, LstCol As Integer
    'Loop Vars
    Dim CurRow As Integer, CurCol As Integer, i As Integer, j As Integer, k As Integer
    'Var for Testing if array
    Dim ArrayTest As Variant
    'Initiate Arr
    Dim ExcArr() As String
    ReDim ExcArr(1 To 1) As String
    ExcArr(1) = ""
    'Cell the UDF is called from
    Dim CurCell As Variant
    'Dim CurCell As Range
    'Set CurCell = Range(Replace(Application.Caller.Address, "$", ""))
    If TypeName(Application.Caller) = "Range" Then
        Set CurCell = Range(Replace(Application.Caller.Address, "$", ""))
    ElseIf TypeName(Application.Caller) = "String" Then
        Set CurCell = Range(Application.Caller)
    Else
        codeoferror = "00 - unexpected error"
        GoTo ERRORHANDLING
    End If

    'Create Array with all Vals of ExceptionRange
    'ExceptionRange is defined as the Range
    ' between the Heading and the current list-position
    codeoferror = "02 - Heading is missing"
    j = CurCell.Column
    i = CurCell.Row
    Do
        i = i - 1
        If Cells(i, j) <> Heading Then
            ReDim Preserve ExcArr(1 To UBound(ExcArr) + 1)
            ExcArr(UBound(ExcArr)) = Cells(i, j)
        Else
            Exit Do
        End If
    Loop

    'Going through SearchRange searching for Non-Numerics
    For k = LBound(SearchRange, 1) To UBound(SearchRange, 1)
        'Assigning Vals to "Consts"
        codeoferror = "03 - Val assignment error"
        FstRow = SearchRange(k).Row
        FstCol = SearchRange(k).Column
        LstRow = SearchRange(k).Row + SearchRange(k).Rows.Count - 1
        LstCol = SearchRange(k).Column + SearchRange(k).Columns.Count - 1
        codeoferror = "04 - SearchRange error"
        For CurRow = FstRow To LstRow
            For CurCol = FstCol To LstCol
                If IsNumeric(Cells(CurRow, CurCol)) <> OnlyStrings Then
                    'Jump to "ISINARRAY" (to replace an additional function)
                    GoTo ISITINARRAY
ISINARRAY:
                End If
            Next CurCol
        Next CurRow
    Next k
    GoTo FUNCTIONEND

    codeoferror = "05"
ISITINARRAY:
    For i = LBound(ExcArr) To UBound(ExcArr)
        If ExcArr(i) = Cells(CurRow, CurCol) Then GoTo ISINARRAY
    Next i
    LIST2 = Cells(CurRow, CurCol)
    GoTo FUNCTIONEND

    'Errorhandling
ERRORHANDLING:
    LIST2 = "ERROR VBA" & codeoferror

    'End of Function (and its Marker)
FUNCTIONEND:
End Function

1 个答案:

答案 0 :(得分:2)

正如@Zerk所说 - 你需要使用ParamArray。

ParamArrays不能与可选参数结合使用,它必须是列表中的最后一个参数。

此函数采用数字和数组。

Public Function MyUDF(SomeNumber As Long, ParamArray MyArray())

    Dim x As Long
    Dim y As String

    For x = LBound(MyArray) To UBound(MyArray)
        y = y & MyArray(x) & ", "
    Next x

    MyUDF = y & SomeNumber

End Function  

您可以在代码中使用它,如下所示:

Sub Test()

    MsgBox MyUDF(12, "a", "b", "c")

End Sub

或作为工作表功能:=MyUDF(12,"a","b","c")

进一步阅读:
http://www.tushar-mehta.com/publish_train/xl_vba_cases/1005%20ParamArray.shtml