我正在编写一个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
答案 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