我正在编写一个 UDF，试图从未排序的“矩阵”/字符串和数字数组中创建一个列表。我只想列出非数字。到目前为止我已经解决了我所有的问题。但现在我正在努力“实现”动态数量的输入变量。我希望能够标记几个单独的矩阵/数组。
解释一下到目前为止发生的事情:
UDF 称为“LIST”，它有 3 个输入变量:(SearchRange As Range、ExceptionRange As Range、OnlyStrings As Boolean)
SearchRange 是我正在收集数据的范围，ExceptionRange 是要忽略 val 的异常(我必须实现它，因为否则我总是得到相同的字符串。)而 OnlyStrings 正如其名称所示，是一个 bool 值决定是否要在评估过程中考虑数字。
函数调用示例:=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 确实提供了巨大的帮助。现在我必须将列表放在一栏中。所以我能够用一个名为“Heading”的新值替换 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
最佳答案
正如@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
关于arrays - UDF 中变量的动态数量，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/47411550/