2009-11-29 8 views
7

È possibile creare una funzione VBA di Excel che restituisce un array nello stesso modo in cui lo fa LINEST, ad esempio? Vorrei crearne uno che, dato un codice fornitore, restituisca un elenco di prodotti per quel fornitore da una tabella fornitore-prodotto.Funzione VBA di Excel che restituisce un array

+0

Sei riuscito a risolvere il tuo problema? – marg

risposta

5

Penso che Collection potrebbe essere quello che stai cercando.

Esempio:

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 

Edit: Qui è un piuttosto semplice soluzione al problema: compilazione di una casella combinata per i prodotti ogni volta che la casella combinata per i fornitori cambia il suo valore con il minimo possibile di 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 

Note: Ho chiamato ComboBox per Fornitori comboSupplier e quello per Prodotti comboProducts.

+0

Ti piace questo? FoundProds Function (SuppKey As Variant) As Variant Dim ProdCell come gamma Dim SuppCell come gamma Dim Risultati (50) Dim ResultCount come numero intero Dim ProdCol, SuppCol come numero intero ProdCol = 1 'Codice Prodotto in questo colonna' SuppCol = 2 'Codici fornitore sono in questa colonna' ResultCount = 1 Per ogni ProdCell nel campo (Cells (1, ProdCol), celle (ActiveSheet.UsedRange.Rows.Count, ProdCol)) Se SuppKey = SuppCell.Value Then Results (ResultCount) = Celle (ProdCell.Row, ProdCol) .Valore ResultCount = ResultCount + 1 End If Avanti FoundLocations = Risultati End Function –

+0

Ho dimenticato di chiedere: Si desidera restituire l'array a un'altra funzione VBA, giusto? o vuoi usare la funzione direttamente nel tuo foglio di lavoro come una funzione personalizzata? – marg

+0

Vorrei utilizzare la funzione direttamente nel foglio di lavoro Sto cercando di consentire all'utente di scegliere un fornitore da una casella combinata, che quindi compila una seconda casella combinata con i prodotti di quel fornitore, per una seconda scelta. Mi dispiace per il grumo di codice disordinato nel mio commento qui sopra! –

14

ok, qui ho una funzione datamapping che restituisce una matrice di più 'colonne', quindi è possibile ridurla solo a uno. Non importa come viene riempito l'array, in particolare

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