Ash*_*anq 6 excel vba excel-vba user-defined-functions
我正在使用VBA对excel中的函数进行编程,该函数将搜索查找某些名称的列表,在查找某些名称时计数,然后将这些计数器值输出到单个单元格.
当我有多单元格函数时,如何将值分配给函数本身?我已经在同一列中选择了4个单元格并按下了CTRL-SHFT-ENTER以获得多单元格函数我只是不知道如何将结果分配给函数以便它将显示在所选单元格中.我到目前为止所做的工作如下所示:
Function ROM(ByVal lookup_value As Range, _
ByVal lookup_column As Range, _
ByVal return_value_column As Long) As String
Application.ScreenUpdating = False
Dim i As Long
Dim resultCount As Long
Dim resultsArray() As String
Dim arraySize As Long
Dim myrange As Range
Dim results As String
Dim TSS As Long
Dim OSS As Long
Dim AWS As Long
Dim JLI As Long
Dim answers(1 To 3, 1 To 1) As Variant
' The following code works out how many matches there are for the lookup and creates an
' array of the same size to hold these results
Set myrange = lookup_column
arraySize = Application.WorksheetFunction.CountIf(myrange, lookup_value.Value)
ReDim resultsArray(arraySize - 1)
' A counter for the results
resultCount = 0
TSS = 0
OSS = 0
AWS = 0
JLI = 0
' The equipment ID column is looped through and for every match the corresponding Equipment Type is
' saved into the resultsArray for analysis
For i = 1 To lookup_column.Rows.count
If Len(lookup_column(i, 1).Text) <> 0 Then
If lookup_column(i, 1).Text = lookup_value.Value Then
' If statement to ensure that the function doesnt cycle to a number larger than the
' size of resultsArray
If (resultCount < (arraySize)) Then
resultsArray(resultCount) = (lookup_column(i).Offset(0, return_value_column).Text)
results = (lookup_column(i).Offset(0, return_value_column).Text)
resultCount = resultCount + 1
' The following code compares the string to preset values and increments
' the counters if any are found in the string
If (InStr(results, "TPWS TSS") > 0) Then
TSS = TSS + 1
ElseIf (InStr(results, "TPWS OSS")) Then
OSS = OSS + 1
ElseIf (InStr(results, "JUNCTION INDICATOR (1 Route)") > 0) Then
JLI = JLI + 1
ElseIf (InStr(results, "AWS")) Then
AWS = AWS + 1
End If
End If
End If
End If
Next
answers(1, 1) = TSS
answers(1, 2) = OSS
answers(1, 3) = AWS
answers(1, 4) = 0
ROM = answers
Application.ScreenUpdating = True
End Function
Run Code Online (Sandbox Code Playgroud)
当我尝试运行该功能时,它一直在说类型不匹配的答案.为多细胞配方选择的细胞是F18,G18,H18和I18.
从VBA返回数组函数
试试这个
Function MyArray() As Variant
Dim Tmp(3) As Variant
Tmp(0) = 1
Tmp(1) = "XYZ"
Tmp(2) = 3
Tmp(3) = 4
MyArray = Tmp
End Function
Run Code Online (Sandbox Code Playgroud)
现在选择F18..I18,输入= MyArray()并按Ctrl + Shift + Enter
希望这可以帮助.