2012-10-09 30 views
5

Estoy usando VBA para programar una función en Excel que buscará una lista buscando ciertos nombres, contará cuando aparezcan ciertos nombres buscados y luego dará salida a estos valores de contador para cada individuo Células.Resultado de la función Ouput del cálculo de varias celdas en Excel usando VBA

¿Cómo asigno los valores a la función en sí cuando tengo una función de múltiples células? He elegido 4 celdas una al lado de la otra en la misma columna y presioné CTRL-SHFT-ENTER para obtener una función multicelda. Simplemente no sé cómo asignar resultados a la función para que se muestre en las celdas seleccionadas. Lo que he hecho hasta ahora es el siguiente:

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 

Cuando trato de ejecutar la función que sigue diciendo que no coincide el tipo de respuestas. Las celdas seleccionadas para la fórmula de celdas múltiples son F18, G18, H18 e I18.

Respuesta

5

Para regresar un arreglo de funciones de VBA

  1. su función debe ser de tipo Variant
  2. su matriz de salida debe coincidir con el rango seleccionado - en su caso, debe ser de 1 dimensión mientras que se está acotando una matriz de 2 dimensiones

Prueba este

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 

Ahora seleccione F18..I18, ingrese = MiMatriz() y presione Ctrl + Mayús + Ingrese

Espero que esto ayude.

+0

¡Gracias! Eso hizo el truco. – Ashmanq

1

Primero, aparece una discrepancia de tipo porque intenta asignar el resultado a una Cadena. Si asigna una Variante, evitará ese problema.

En segundo lugar, la matriz answers debe dimensionarse como:

Dim answers(3) As Variant

El siguiente código debe trabajar para usted si he entendido correctamente el problema.

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 
1

Esto puede variar según la versión de Excel que esté utilizando. Estoy usando el paquete Office2003 y las soluciones presentadas anteriormente no funcionan con esta versión de Excel.

Me parece que necesita una salida de matriz de dos diminutas a Excel con los valores en la segunda disminución.

Pediré prestado el ejemplo anterior de MikeD y lo modificaré para que funcione en 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 

Tenga en cuenta que puede volver a diminsion la matriz de usar una salida dinámica, pero hay que seleccionar un rango lo suficientemente grande como para abarcar la totalidad de su producción cuando se inserta la función en Excel.

Cuestiones relacionadas