2009-11-29 17 views
7

Örneğin, bir dizeyi LINEST ile aynı şekilde döndüren bir Excel VBA işlevi oluşturabilir misiniz? Bir tedarikçi kodu verildiğinde, bir tedarikçi-tedarikçi tablosundan bu tedarikçi için bir ürün listesi döndüren bir tane oluşturacağım.Bir diziyi döndüren Excel VBA işlevi

+0

Sorununuzu çözebildiniz mi? – marg

cevap

5

Bence Collection sizin için uygun olabilir.

Örnek:

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 

Düzenleme: Tedarikçiler için ComboBox mümkün olduğunca az vba ile o değerini her değiştirdiğinde Ürünler için bir ComboBox doldurmamak: Burada Sorununa oldukça basit bir çözümdür.

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 

Notlar: Ben Tedarikçiler comboSupplier için ComboBox ve Ürünleri comboProducts için bir tane adını verdi.

+0

Bunu beğendiniz mi? Fonksiyon FoundProds (As Variant SuppKey) Varyant Tamsayı Dim ProdCol, As Integer SuppCol olarak Dim ProdCell As Range Dim SuppCell As Range Dim Sonuçları (50) Dim RESULTCOUNT olarak bu ProdCol = 1 'Ürün Kodu kolon' SuppCol = 2 'alanı Kodları Her ProdCell sınıf için bu sütunda' RESULTCOUNT = 1 içindedir (hücreler (1, ProdCol), hücreler (ActiveSheet.UsedRange.Rows.Count, ProdCol)) ise SuppKey = SuppCell.Value Sonra Sonuçlar (ResultCount) = Hücreler (ProdCell.Row, ProdCol) .Value ResultCount = SonuçÜlk + 1 Sonu Sonraki FoundLocations = Sonuçlar Bitiş Fonksiyonu –

+0

Sormayı unuttum: Diziyi başka bir VBA işlevine döndürmek ister misiniz? veya işlevi doğrudan çalışma sayfanızda özel bir işlev olarak kullanmak ister misiniz? – marg

+0

Fonksiyonu doğrudan çalışma sayfasında kullanmak istiyorum Kullanıcının bir açılan kutudan bir tedarikçi seçmesine izin vermeye çalışıyorum, daha sonra ikinci bir seçim için o tedarikçinin ürünleri ile ikinci bir açılan kutuyu dolduracağım. Yukarıdaki yorumumdaki dağınık kod yığını için üzgünüm! –

14

Tamam, burada birden çok 'sütun' dizisi döndüren bir veribirlemim var, böylece bunu yalnızca bir taneye küçültebilirsiniz. Dizinin nasıl yoğunlaştığı gerçekten önemli değil, özellikle

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