2009-11-29 42 views
7

¿Se puede crear una función de Excel VBA que devuelva una matriz de la misma manera que lo hace LINEST, por ejemplo? Me gustaría crear uno que, dado un código de proveedor, devuelva una lista de productos para ese proveedor de una tabla de proveedor de productos.Función de Excel VBA que devuelve una matriz

+0

¿Pudo resolver su problema? – marg

Respuesta

5

Creo que Collection podría ser lo que estás buscando.

Ejemplo:

Private Function getProducts(ByVal supplier As String) As Collection 
    Dim getProducts_ As New Collection 

    If supplier = "ACME" Then 
     getProducts_.Add ("Anvil") 
     getProducts_.Add ("Earthquake Pills") 
     getProducts_.Add ("Dehydrated Boulders") 
     getProducts_.Add ("Disintegrating Pistol") 
    End If 

    Set getProducts = getProducts_ 
    Set getProducts_ = Nothing 
End Function 

Private Sub fillProducts() 
    Dim products As Collection 
    Set products = getProducts("ACME") 
    For i = 1 To products.Count 
     Sheets(1).Cells(i, 1).Value = products(i) 
    Next i 
End Sub 

Editar: Aquí es una solución muy simple para el problema: Llenar un ComboBox de los productos cada vez que el cuadro combinado de Proveedores cambia su valor con tan poco como sea posible VBA.

Public Function getProducts(ByVal supplier As String) As Collection 
    Dim getProducts_ As New Collection 
    Dim numRows As Long 
    Dim colProduct As Integer 
    Dim colSupplier As Integer 
    colProduct = 1 
    colSupplier = 2 

    numRows = Sheets(1).Cells(1, colProduct).CurrentRegion.Rows.Count 

    For Each Row In Sheets(1).Range(Sheets(1).Cells(1, colProduct), Sheets(1).Cells(numRows, colSupplier)).Rows 
     If supplier = Row.Cells(1, colSupplier) Then 
      getProducts_.Add (Row.Cells(1, colProduct)) 
     End If 
    Next Row 

    Set getProducts = getProducts_ 
    Set getProducts_ = Nothing 
End Function 

Private Sub comboSupplier_Change() 
    comboProducts.Clear 
    For Each Product In getProducts(comboSupplier) 
     comboProducts.AddItem (Product) 
    Next Product 
End Sub 

Notas: Me nombrado el cuadro combinado de Proveedores comboSupplier y el de productos comboProducts.

+0

¿Te gusta? FoundProds función (SuppKey como variante) como variante Dim ProdCell como gama Dim SuppCell como gama Dim Resultados (50) Dim RESULTCOUNT como número entero Dim ProdCol, SuppCol como número entero ProdCol = 1 'Código del producto en este columna' SuppCol = 2 'códigos de proveedores están en esta columna' RESULTCOUNT = 1 Para Cada ProdCell en el radio (células (1, ProdCol), células (ActiveSheet.UsedRange.Rows.Count, ProdCol)) Si SuppKey = SuppCell.Value Then Resultados (ResultCount) = Celdas (ProdCell.Row, ProdCol) .Valor ResultCount = ResultCount + 1 End If Next FoundLocations = Resultados End Function –

+0

Olvidé preguntar: ¿Desea devolver la matriz a otra función de VBA, ¿verdad? o ¿desea utilizar la función directamente en su hoja de trabajo como una función personalizada? – marg

+0

Me gustaría usar la función directamente en la hoja de trabajo Estoy tratando de dejar que el usuario elija un proveedor de un cuadro combinado, que luego rellenará un segundo cuadro combinado con los productos de ese proveedor, para una segunda opción. Perdón por el desorden de código en mi comentario anterior! –

14

bien, aquí tengo una función de mapeo de datos que devuelve una matriz de múltiples 'columnas', por lo que puede reducir esto solo a una. No importa realmente cómo se llena el conjunto, particularmente

Function dataMapping(inMapSheet As String) As String() 

    Dim mapping() As String 

    Dim lastMapRowNum As Integer 

    lastMapRowNum = ActiveWorkbook.Worksheets(inMapSheet).Cells.SpecialCells(xlCellTypeLastCell).Row 

    ReDim mapping(lastMapRowNum, 3) As String 
    For i = 1 To lastMapRowNum 
     If ActiveWorkbook.Worksheets(inMapSheet).Cells(i, 1).Value <> "" Then 
     mapping(i, 1) = ActiveWorkbook.Worksheets(inMapSheet).Cells(i, 1).Value 
     mapping(i, 2) = ActiveWorkbook.Worksheets(inMapSheet).Cells(i, 2).Value 
     mapping(i, 3) = ActiveWorkbook.Worksheets(inMapSheet).Cells(i, 3).Value 
     End If 
    Next i 

    dataMapping = mapping 

End Function 




Sub mysub() 

    Dim myMapping() As String 
    Dim m As Integer 

    myMapping = dataMapping(inDataMap) 

    For m = 1 To UBound(myMapping) 

    ' do some stuff 

    Next m 

end sub