Question

我正在使用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

当我尝试运行该功能时，它一直在说类型不匹配的答案。为多细胞配方选择的细胞是F18，G18，H18和I18。

Answer 1

从VBA返回数组函数

您的函数必须是Variant类型
您的输出数组必须与所选范围匹配 - 在您的情况下，它必须是1维的而你正在确定一个二维数组的尺寸

试试这个

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

现在选择F18..I18，输入= MyArray（）并按Ctrl + Shift + Enter

希望这有帮助。

Answer 2

首先，你得到的类型不匹配是因为你试图将结果赋给String。如果您分配给Variant，您将避免该问题。

其次，您的answers数组的大小应为：

Dim answers(3) As Variant

如果我已正确理解问题，以下代码应该适合您。

Function ROM(ByVal lookup_value As Range, _
ByVal lookup_column As Range, _
ByVal return_value_column As Long) As Variant

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(3) 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(0) = TSS
 answers(1) = OSS
 answers(2) = AWS
 answers(3) = 0

  ROM = answers


Application.ScreenUpdating = True


End Function

Answer 3

这可能会因您使用的Excel版本而异。我使用的是Office2003套件，上面介绍的解决方案不适用于此版本的Excel。

我发现你需要一个两个diminsion数组输出到Excel，第二个diminsion中的值。

我将借用上面的MikeD示例并将其修改为在Excel2003中工作。

Function MyArray() As Variant
Dim Tmp() As Variant

redim Tmp(3,0) as Variant

Tmp(0,0) = 1
Tmp(1,0) = "XYZ"
Tmp(2,0) = 3
Tmp(3,0) = 4

MyArray = Tmp

End Function

请注意，您可以重新调整数组以使用动态输出，但是在将函数插入Excel时，必须选择足够大的范围以包含所有输出。

使用VBA在Excel中计算多个单元格的输出函数结果

3 个答案: