web-dev-qa-db-ja.com

配列を返すExcel VBA関数

たとえば、LINESTと同じ方法で配列を返すExcel VBA関数を作成できますか？サプライヤコードを指定すると、製品サプライヤテーブルからそのサプライヤの製品のリストを返すものを作成します。

excelvbaexcel-vba
11
user220894

わかりました、ここに複数の「列」の配列を返す関数データマッピングがありますので、これを1つに縮小できます。特に配列がどのように配置されるかは特に問題ではありません

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

Collectionはあなたが探しているものかもしれません。

例：

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

編集：問題に対する非常に単純な解決策です。サプライヤーのComboBoxの値が変更されるたびに、製品のComboBoxに値を設定し、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

注：サプライヤのComboBoxにcomboSupplierおよび製品のcomboProductsの名前を付けました。

8
marg