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

Question

提问by Ashmanq

Im using VBA to program a function in excel that will search a list looking for certain names, count when certain sought for names come up and then output these counter values to individual cells.

我使用 VBA 在 excel 中编写一个函数，该函数将搜索列表以查找某些名称，当某些名称出现时进行计数，然后将这些计数器值输出到单个单元格。

How do I allocate the values to the function itself when I have a multi cell function? Ive chosen 4 cells next to each other in the same column and pressed CTRL-SHFT-ENTER to get a multi cell function I just dont know how to allocate results to the function so that it will show in the selected cells. What I've done so far is shown below:

当我有一个多单元格函数时，如何将值分配给函数本身？我在同一列中选择了 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

When I try running the function it keeps saying type mismatch for answers. The cells selected for the multi cell formula are F18, G18, H18 and I18.

当我尝试运行该函数时，它一直说答案类型不匹配。为多单元格公式选择的单元格是 F18、G18、H18 和 I18。

Answer 1

采纳答案by MikeD

To return array functions from VBA

从 VBA 返回数组函数

your function must be of type Variant
your output array must match the selected range - in your case it must be 1-dimensional whereas you are dimensioning a 2-dimensional array

你的函数必须是 Variant 类型
您的输出数组必须与所选范围匹配 - 在您的情况下，它必须是一维的，而您正在对二维数组进行尺寸标注

Try this

尝试这个

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

Now select F18..I18, enter =MyArray() and press Ctrl+Shift+Enter

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

Hope this helps.

希望这可以帮助。

Answer 2

回答by Maineac

This may vary depending on the version of Excel you are using. I am using the Office2003 suite and the solutions presented above do not work with this version of Excel.

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

I find that you need a two diminsion array output to Excel with the values in the second diminsion.

我发现您需要一个二维数组输出到 Excel，其中包含第二个维度中的值。

I'll borrow MikeD's example above and modify it to work in Excel2003.

我将借用上面 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

Note that you can re-diminsion your array to use a dynamic output, but you must select a large enough range to encompass all of your output when you insert the function into Excel.

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

Answer 3

回答by Jamie Bull

First, you're getting the type mismatch because you're trying to assign the result to a String. If you assign to a Variant you'll avoid that problem.

首先，因为您试图将结果分配给一个字符串，所以类型不匹配。如果您分配给变体，您将避免该问题。

Second, your answersarray should be dimensioned as:

其次，您的answers数组的尺寸应为：

Dim answers(3) As Variant

The following code should work for you if I've understood the problem correctly.

如果我正确理解了问题，以下代码应该对您有用。

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

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

提问by Ashmanq

采纳答案by MikeD

回答by Maineac

回答by Jamie Bull

相关推荐

最近更新

标签

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

提问by Ashmanq

采纳答案by MikeD

回答by Maineac

回答by Jamie Bull

相关推荐

Excel VBA：将循环遍历唯一名称组并创建相应图表的图表制作宏？

vba 如何在 Office 文件中为自定义功能区嵌入图像

vba 格式条件和内部颜色

vba 比较Excel VBA中的两列（大于/小于或等于）

相关推荐

最近更新

标签