Funkcja funkcji Ouput z obliczeń do wielu komórek w programie Excel przy użyciu VBA

Question

Im przy użyciu VBA do zaprogramowania funkcji w programie Excel, który przeszuka listę w poszukiwaniu niektórych nazw, policzyć, gdy niektóre poszukiwane nazwy wymyślić, a następnie wyprowadzić te wartości licznika do poszczególnych komórki.

Jak przydzielić wartości do samej funkcji, gdy mam funkcję wielu komórek? Wybrałem 4 komórki obok siebie w tej samej kolumnie i wcisnąłem CTRL-SHFT-ENTER, aby uzyskać funkcję wielu komórek. Nie wiem tylko, jak przydzielić wyniki do funkcji, aby była wyświetlana w wybranych komórkach. To, co zrobiłem do tej pory, pokazano poniżej:

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 

Kiedy próbuję uruchomić tę funkcję, ciągle mówi się o niezgodności typu dla odpowiedzi. Komórki wybrane dla formuły wielokomórkowej to F18, G18, H18 i I18.

Answer 1

Aby przywrócić funkcje tablicowe z VBA

1. czynność musi być typu Variant
2. macierzy wyjściowa musi pasować do wybranego zakresu - w danym przypadku musi to być 1-wymiarowej natomiast jesteś wymiarowania 2-wymiarową tablicę

Spróbuj

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 

Teraz wybierz F18..I18, wejdź = MyArray() i naciśnij Ctrl + Shift + Enter

Mam nadzieję, że to pomoże.

Answer 2

Po pierwsze, pojawia się niedopasowanie typu, ponieważ próbujesz przypisać wynik do łańcucha znaków. Jeśli przypiszesz Wariant, unikniesz tego problemu.

drugiej macierzy answers powinny mieć takie wymiary jak:

Dim answers(3) As Variant

Poniższy kod powinien pracować dla Ciebie, jeśli mam rozumieć problem poprawnie.

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

Może się różnić w zależności od używanej wersji programu Excel. Korzystam z pakietu Office2003, a przedstawione powyżej rozwiązania nie działają z tą wersją programu Excel.

Uważam, że potrzebujesz dwóch wymiarów diminsion output do Excela z wartościami w drugim diminsion.

Pożyczę powyższy przykład Mike'a i zmodyfikuję go do pracy w 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 

pamiętać, że można ponownie diminsion swoją tablicę użyć wyjścia dynamiczne, ale trzeba wybrać dość duży zakres obejmuje wszystkie swoje wyjście po wstawieniu funkcji do programu Excel.