6

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 です。

4

3 に答える 3

6

VBA から配列関数を返すには

  1. 関数はバリアント型でなければなりません
  2. 出力配列は選択した範囲と一致する必要があります-あなたの場合、2次元配列を次元化しているのに対し、それは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 を押します。

お役に立てれば。

于 2012-10-09T16:18:18.813 に答える
1

まず、結果を文字列に代入しようとしているため、型の不一致が発生しています。バリアントに割り当てると、その問題を回避できます。

次に、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
于 2012-10-09T16:22:47.897 に答える