web-dev-qa-db-fra.com

Excel VBA fonction renvoyant un tableau

Pouvez-vous créer une fonction Excel VBA qui renvoie un tableau de la même manière que la linéaire, par exemple? Je voudrais en créer un qui, étant donné un code de fournisseur, renvoie une liste de produits pour ce fournisseur à partir d'une table fournisseur de produits.

excelvbaexcel-vba
11
user220894

ok, j'ai ici une fonction Datamappe de la fonction qui renvoie une gamme de multiples "colonnes", de sorte que vous puissiez rétrécir cela juste à un. N'aimable pas comment le tableau est peuplé, en particulier

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
21
moleboy

Je pense que Collection pourrait être ce que vous recherchez.

Exemple:

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

éditer : Voici une solution assez simple au problème: peupler une combinaison d'une combinaison pour les produits chaque fois que le ComboBox pour les fournisseurs change sa valeur avec le moins de VBA possible.

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

Remarques: J'ai nommé le ComboBox pour les fournisseurs ComboSuppLIPLIPLIPLIPLIPLIER et celui des produits de produits de produits.

8
marg