Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/16.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel VBA函数返回数组_Vba_Excel - Fatal编程技术网

Excel VBA函数返回数组

Excel VBA函数返回数组,vba,excel,Vba,Excel,例如,能否创建一个Excel VBA函数,以与LINEST相同的方式返回数组?我想创建一个,给定供应商代码,从产品供应商表中返回该供应商的产品列表 我想收藏可能就是你要找的 例如: Private Function getProducts(ByVal supplier As String) As Collection Dim getProducts_ As New Collection If supplier = "ACME" Then getProducts_

例如,能否创建一个Excel VBA函数,以与LINEST相同的方式返回数组?我想创建一个,给定供应商代码,从产品供应商表中返回该供应商的产品列表

我想
收藏
可能就是你要找的

例如:

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
编辑: 对于这个问题,这里有一个非常简单的解决方案:只要供应商的组合框的值发生变化,就用尽可能少的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

注意:我为Suppliers comboSupplier命名了ComboBox,为Products comboProducts命名了ComboBox。

好的,这里我有一个函数datamapping,它返回多个“列”的数组,因此您可以将其缩小为一个。 数组如何填充并不重要,尤其是

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   
函数数据映射(inMapSheet作为字符串)作为字符串()
Dim mapping()作为字符串
将lastMapRowNum设置为整数
lastMapRowNum=ActiveWorkbook.Worksheets(inMapSheet).Cells.SpecialCells(xlCellTypeLastCell).Row
作为字符串的ReDim映射(lastMapRowNum,3)
对于i=1到lastMapRowNum
如果ActiveWorkbook.Worksheets(inMapSheet).Cells(i,1).Value为“”,则
映射(i,1)=活动工作簿。工作表(inMapSheet)。单元格(i,1)。值
映射(i,2)=活动工作簿。工作表(inMapSheet)。单元格(i,2)。值
映射(i,3)=活动工作簿。工作表(inMapSheet)。单元格(i,3)。值
如果结束
接下来我
数据映射=映射
端函数
副秘书长()
Dim myMapping()作为字符串
将m作为整数
myMapping=数据映射(inDataMap)
对于m=1到uBond(myMapping)
“做点什么
下一个m
端接头

像这样吗?函数FoundProds(SuppKey作为变量)作为变量Dim ProdCell作为范围Dim SuppCell作为范围Dim结果(50)Dim ResultCount作为整数Dim ProdCol,SuppCol作为整数ProdCol=1“此列中的产品代码”SuppCol=2“此列中的供应商代码”范围中的每个ProdCell(单元格(1,ProdCol),单元格的ResultCount=1(ActiveSheet.UsedRange.Rows.Count,ProdCol))如果SuppKey=SuppCell.Value,则结果(ResultCount)=单元格(ProdCell.Row,ProdCol).Value ResultCount=ResultCount+1 End If Next FoundLocations=Results End function我忘了问:您想将数组返回到另一个VBA函数,对吗?还是想直接在工作表中使用该函数作为自定义函数?我想直接在工作表中使用该函数我正在尝试让用户从组合框中选择一个供应商,然后在第二个组合框中填充该供应商的产品,作为第二选择。很抱歉,我在上面的评论中出现了一堆乱七八糟的代码!我们是在讨论通过插入到验证条件中的命名范围创建的控件还是列表?如果是控件,您只需要在支持框中放置一个子控件lierCombobox\u更改事件,如果是验证规则,我相信我们需要使用命名范围,它是一个控件。虽然我试图避免太多VBA,因为我将不得不向一些不太懂it的人展示此电子表格,所以我不希望将内容隐藏在事件和sich中……他们可能需要处理用户定义的函数。是吗能解决你的问题吗?