VBA-需要创建一个函数,以范围作为输入

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/11408013/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 13:29:31  来源:igfitidea点击:

VBA- Need to create a function, which takes the range as input

vbaexcel-vbaexcel

提问by Rachit

I have a two dimensional table in Excel. eg.

我在 Excel 中有一个二维表。例如。

outputproduct      blending combination
**5                P1:0.6/P3:0.5**
  2                P1:0.3/P2:0.7
  4                P5:0.4/P2:0.7
  7                P11:0.7/P7:0.4

Suppose the range of the table varies from B2:C6 (it can vary). I have to create a function, whose first job is to read this range( which would be a user defined input) and then stores the data into a 2 dimensional array such that I could use the data(integer) in the first column and the string in the second column, appropriately.

假设表格的范围从 B2:C6 变化(它可以变化)。我必须创建一个函数,它的第一个工作是读取这个范围(这将是一个用户定义的输入),然后将数据存储到一个二维数组中,这样我就可以使用第一列中的数据(整数)和字符串在第二列,适当地。

The first column is the resultant product index, while the second column is the blending products in the given ratio, which combine together to give the product in the first column.

第一列是生成的产品索引,而第二列是给定比例的混合产品,它们组合在一起得到第一列中的产品。

Then there is another table:

然后还有一张表:

product index      current stock    updated stock
      **1**             **10**
        2                 20 
      **3**             **50**
        4                 15
      **5**             **100**
        .                 .
        .                 .
        .                 .

I have to update the stock amount in this table after the data processing. For example, on combination of product 1 with product 3 in the ratio of 6:5 (units), 1 unit of product 5 is produced. So, I have to update the amount of stock for each of the products in table 2.

数据处理后,我必须更新此表中的库存量。例如,产品 1 与产品 3 以 6:5(单位)的比例组合,生产 1 单位产品 5。因此,我必须更新表 2 中每种产品的库存量。

Any suggestions, how to convert the range into a 2 dimensional array?

任何建议,如何将范围转换为二维数组?

Public Function Blending_function( R1 as Range, R2 as Range)
 ' R2 is the range of table 2, where the updating is to be done
 ' R1 is first stored in to a 2 dimensional array, such that the data in the
 ' column 1 could be read, and the data in the column 2 could be read (of table 1).
 ' the integer in the column 1 of table 1 refers to the product index in table 2.
 ' P(i) stands for the ith product. In first row of table-1, P1 and P3 combine in the 
 ' ratio of 6:5 to give P5. The current stock of each product is provide in table-2,
 ' whose range is R2(entire table 2).

 ' R1 is the range of table 1, from where the processing is to be done


End Function 

The main hurdle for me is to convert the range R1 (Table-1) into a 2 dimensional array. And then look from that array, the index of the output product, and locate that product in table-2 for updating the stock level.

我的主要障碍是将范围 R1(表 1)转换为二维数组。然后从该数组中查看输出产品的索引,并在表 2 中找到该产品以更新库存水平。

回答by Siddharth Rout

Here is an example on how to work with 2D array. The function will break up the blending combinationand extract the values that you want so that you can use those.

这是有关如何使用二维数组的示例。该函数将分解blending combination并提取您想要的值,以便您可以使用这些值。

Sub Sample()
    Dim Rng1 As Range, Rng2 As Range

    On Error Resume Next
    Set Rng1 = Application.InputBox("Please select the Table1 Range", Type:=8)
    On Error GoTo 0

    If Rng1.Columns.Count <> 2 Then
        MsgBox "Please select a range which is 2 columns wide"
        Exit Sub
    End If

    On Error Resume Next
    Set Rng2 = Application.InputBox("Please select the Table2 Range", Type:=8)
    On Error GoTo 0

    If Rng2.Columns.Count <> 3 Then
        MsgBox "Please select a range which is 3 columns wide"
        Exit Sub
    End If

    Blending_function Rng1, Rng2

End Sub

Public Function Blending_function(R1 As Range, R2 As Range)
    Dim MyAr1 As Variant, MyAr2 As Variant
    Dim i As Long
    Dim blndCom As String, OutputPrd As String
    Dim ArP1() As String, ArP2() As String, tmpAr() As String

    MyAr1 = R1

    For i = 2 To UBound(MyAr1, 1)
        OutputPrd = MyAr1(i, 1)
        blndCom = MyAr1(i, 2)
        tmpAr = Split(blndCom, "/")

        ArP1 = Split(tmpAr(0), ":")
        ArP2 = Split(tmpAr(1), ":")

        Debug.Print OutputPrd
        Debug.Print Trim(ArP1(0))
        Debug.Print ArP1(1)
        Debug.Print ArP2(0)
        Debug.Print ArP2(1)
        Debug.Print "-------"
    Next
End Function

SNAPSHOT

快照

enter image description here

enter image description here

Once you have these values you can use .Findto search for the product indexin the range R2and then use .Offsetto enter your formula.

获得这些值后,您可以使用.Findproduct index在范围内搜索R2,然后使用它.Offset来输入您的公式。

回答by Trace

I'm not sure if I understood the entire story, but this is what a function to return
a multidimensional array could look like:

我不确定我是否理解了整个故事,但这就是返回
多维数组的函数的样子:

Public Sub Main_Sub()

Dim vArray_R1()                     As Variant
Dim oRange                          As Range


Set oRange = ThisWorkbook.Sheets(1).Range("A1:B5")
vArray_R1 = Blending_function(oRange)
'You do the same for The second array.     

set oRange = nothing

End Sub

Public Function Blending_function(R1 As Range)

 Dim iRange_Cols As Integer
 Dim iRange_Rows As Integer


iRange_Cols = R1.Columns.Count
iRange_Rows = R1.Rows.Count

'Set size of the array (an existing array would be cleared)
ReDim vArray(1 To iRange_Rows, 1 To iRange_Cols)

vArray = R1
Blending_function = vArray

End Function

A second option could be to declare the function to return a boolean and since arguments are standard sent byRef; you can declare the ranges and arrays in the main sub only, and convert them both at the same time in the function. I wouldn't choose for this option, because you wouldn't be able to re-use the function afterwards to convert other ranges into arrays.

第二种选择可能是声明函数返回一个布尔值,因为参数是由 Ref 标准发送的;您只能在 main sub 中声明范围和数组,并在函数中同时转换它们。我不会选择此选项,因为之后您将无法重新使用该函数将其他范围转换为数组。

Supplementary info: This technique works both ways. You can afterwards define a range and do:

补充信息:这种技术是双向的。之后您可以定义一个范围并执行以下操作:

set oRange = vArray

This on the condition that the Range has the same size as the array.

这是在 Range 与数组具有相同大小的条件下。

回答by sreehari

row = 2
column = "B"
Do While Len(Range(column & row).Formula) > 0
    ' repeat until first empty cell in column 'column'(user input)
    ' read (column, row) and (column+1, row) value
     Cells(row, column).Value
     Cells(row, column+1).value
    ' store in Array
Loop