Ouput chức năng kết quả tính toán cho nhiều tế bào trong Excel bằng VBA

Question

Im sử dụng VBA để lập trình một hàm trong excel mà sẽ tìm kiếm một danh sách tìm kiếm tên nào đó, đếm khi nhất định tìm cho tên đi lên và sau đó đầu ra các giá trị ngược lại với cá nhân ô.

Làm thế nào để phân bổ các giá trị để các chức năng riêng của mình khi tôi có một chức năng tế bào đa? Ive đã chọn 4 ô bên cạnh nhau trong cùng một cột và nhấn CTRL-SHFT-ENTER để nhận hàm đa ô, tôi không biết cách phân bổ kết quả cho hàm để nó sẽ hiển thị trong các ô được chọn. Những gì tôi đã thực hiện cho đến thời điểm này được hiển thị bên dưới:

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 

Khi tôi thử chạy chức năng, nó vẫn cho biết loại không khớp cho câu trả lời. Các ô được chọn cho công thức đa ô là F18, G18, H18 và I18.

Answer 1

Để trở về chức năng mảng từ VBA

1. chức năng của bạn phải là kiểu Variant
2. mảng đầu ra của bạn phải phù hợp với phạm vi lựa chọn - trong trường hợp của bạn nó phải là 1 chiều trong khi bạn đang dimensioning một 2 chiều mảng

Hãy thử điều này

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 

Bây giờ hãy chọn F18..I18, nhập = MyArray() và nhấn Ctrl + Shift + Enter

Hy vọng điều này sẽ hữu ích.

Answer 2

Trước tiên, bạn đang nhận được loại không phù hợp bởi vì bạn đang cố gắng để gán kết quả vào một String. Nếu bạn gán cho một Biến thể bạn sẽ tránh được vấn đề đó.

Thứ hai, mảng answers bạn nên kích thước tương như:

Dim answers(3) As Variant

Các mã sau đây nên làm việc cho bạn nếu tôi đã hiểu vấn đề một cách chính xác.

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

Điều này có thể khác nhau tùy thuộc vào phiên bản Excel bạn đang sử dụng. Tôi đang sử dụng bộ Office2003 và các giải pháp được trình bày ở trên không hoạt động với phiên bản Excel này.

tôi thấy rằng bạn cần một hai diminsion đầu ra mảng sang Excel với các giá trị trong diminsion thứ hai.

Tôi sẽ mượn ví dụ của MikeD ở trên và sửa đổi nó để hoạt động trong 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 

Lưu ý rằng bạn có thể tái diminsion mảng của bạn để sử dụng một lượng năng động, nhưng bạn phải chọn một phạm vi đủ rộng để bao gồm tất cả các đầu ra của bạn khi bạn chèn chức năng vào Excel.