UDF 中变量的动态数量
Dynamic amount of vars in UDF
我正在编写一个 UDF，试图从未排序的 "matrix"/字符串和数字数组中创建一个列表。我只想列出 non-numerics。到目前为止，我已经解决了所有问题。但是现在我正在努力处理 "implementing" 动态数量的输入变量。我希望能够标记几个单独的 matrices/arrays.
解释到目前为止发生的事情：
UDF 称为 "LIST"，它有 3 个输入变量：（SearchRange As Range，ExceptionRange As Range，OnlyStrings As Boolean）
SearchRange 是我正在收集数据的范围，ExceptionRange 是要忽略什么 val 的异常（我必须实现它，否则我总是得到相同的字符串。）而 OnlyStrings 是，顾名思义, 一个布尔值，用于决定是否要在评估过程中考虑数字。
函数调用示例：=LIST($C:$N;$C: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 真的帮了大忙。现在我有必要将列表放在一列中。所以我能够用一个名为 "Heading" 的新 val 替换 ExceptionRange - 它代表我的列表的标题。这导致单元格中的以下函数调用：
=LIST2("benötigt" ;TRUE ;$C:$N;$A:$A)
'=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
正如@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
我正在编写一个 UDF，试图从未排序的 "matrix"/字符串和数字数组中创建一个列表。我只想列出 non-numerics。到目前为止，我已经解决了所有问题。但是现在我正在努力处理 "implementing" 动态数量的输入变量。我希望能够标记几个单独的 matrices/arrays.
解释到目前为止发生的事情：
UDF 称为 "LIST"，它有 3 个输入变量：（SearchRange As Range，ExceptionRange As Range，OnlyStrings As Boolean）
SearchRange 是我正在收集数据的范围，ExceptionRange 是要忽略什么 val 的异常（我必须实现它，否则我总是得到相同的字符串。）而 OnlyStrings 是，顾名思义, 一个布尔值，用于决定是否要在评估过程中考虑数字。
函数调用示例：=LIST($C:$N;$C: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 真的帮了大忙。现在我有必要将列表放在一列中。所以我能够用一个名为 "Heading" 的新 val 替换 ExceptionRange - 它代表我的列表的标题。这导致单元格中的以下函数调用：
=LIST2("benötigt" ;TRUE ;$C:$N;$A:$A)
'=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
正如@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