问返回数组的Excel VBA函数

EN

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   

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

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