循环将值复制到数组中

I’m in a situation where I need to reproduce something in VBA and a bit stuck given my lack of understanding of object oriented language and VBA in general.

我现在需要在VBA中复制一些东西，但是由于我对面向对象语言和VBA缺乏一般的理解，所以有些困难。

Problem:

问题:

• I need to produce an array or vector based on a 2 column table.
• 我需要生成一个基于2列表的数组或向量。
• The first range (column) contains unit counts.
• 第一个范围(列)包含单元计数。
• The second range (column) contains numeric values.
• 第二个范围(列)包含数值。

I need to replicate the value based on the number of units.

我需要根据单位的数量来复制值。

For example,

例如,

if the first row contains 3 units with a value of $100 I need the array to contain $100, $100, $100.
This will need to be looped thru each row containing units.
So if row 2 contains 2 units with a value of $50
I need to complete array to be $100, $100, $100, $50, $50, and so on.

如果第一行包含值为100美元的3个单元，则需要数组包含100美元、100美元和100美元。这需要通过每一行包含单元来循环。因此，如果第2行包含两个值为50美元的单元，我需要将数组完成为100美元，100美元，100美元，50美元，50美元，等等。

I understand this situation will require ReDim the array based on the total values. My struggle is I’ve been unable to figure out the nested for loops.

我理解这种情况需要根据总值重划数组。我的问题是我一直没能找到嵌套的for循环。

I get how to replicate the value based on the number of “units” like the below...

我得到了如何根据“单位”的数量来复制值，如下所示……

    ReDim arr(0 To x - 1)
    For i = 0 To x - 1
    arr(i) = rng.Offset(0, 1).Value
    Next

What is the best way to loop thru each row and replicate the values for each row in the range based on the unit count?

什么是循环遍历每一行的最好方法，并根据单元数复制范围内每一行的值?

If anyone is familiar with R, I'm essentially looking for something that achieves the rep() function (e.g., rep(df$b, df$a)) and return the values in a single array.

如果有人熟悉R，我实际上是在寻找能够实现rep()函数(例如，rep(df$b, df$a)并返回单个数组中的值的东西。

Any help is greatly appreciated. Thanks

非常感谢您的帮助。谢谢

3 个解决方案

#1

Or a one liner which uses the REPT function as you would have used in r :)

或一个使用REPT函数的内衬，就像你在r中使用的那样)

This assumes your data is in A1:B10 - the length can be made variable

这假定您的数据在A1:B10中——长度可以作为变量

s = Split(Join(Application.Transpose(Evaluate("=INDEx(REPT(B1:B10&"","",A1:A10),,1)"))), ",")

s =分裂(加入(Application.Transpose(评估(“=指数(报告(B1:b10“”,“”,A1:A10),,1)"))),“,”)

An an example, to dump the new to array to C1

一个例子，将新的数组转储到C1。

s = Split(Join(Application.Transpose(Evaluate("=INDEx(REPT(B1:B10&"","",A1:A10),,1)"))), ",")
[c1].Resize(UBound(s), 1) = Application.Transpose(s)

#2

When you say Row contains 3 units, do you mean the cell has value 3 or 3 Units? If it is 3 then you may not have to Redim the array in the loop. Simply find the sum of values in Col A which has units and Redim it in one go as shown below.

当你说行包含3个单位时，你是说单元格有3或3个单位吗?如果是3，则不必在循环中重拨数组。只要找到一个有单位的Col A的值的和，就像下面所示。

Sub Sample()
    Dim ws As Worksheet
    Dim Ar() As String
    Dim n As Long, i As Long, lRow As Long

    '~~> Change this to the relevant sheet
    Set ws = Sheet6

    With ws
        n = Application.WorksheetFunction.Sum(.Columns(1))

        ReDim Ar(t To n)

        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        n = 1

        For i = 1 To lRow
            If Len(Trim(.Range("A" & i).Value)) <> 0 Then
                For j = 1 To .Range("A" & i).Value
                    Ar(n) = .Range("B" & i).Value
                    n = n + 1
                Next j
            End If
        Next i

        For i = LBound(Ar) To UBound(Ar)
            Debug.Print Ar(i)
        Next i
    End With
End Sub

Screenshot

截图

And if the cell has 3 Units then you will have to store the values of Col A in an array, do a replace on Unit/Units, find the sum and finally use the above code. Here is an example

如果单元格有3个单位，那么你必须将Col A的值存储在一个数组中，对单位/单位进行替换，找到和，最后使用上面的代码。这是一个例子

Sub Sample()
    Dim ws As Worksheet
    Dim Ar() As String, tmpAr As Variant
    Dim n As Long, i As Long, j As Long, k As Long, lRow As Long

    '~~> Change this to the relevant sheet
    Set ws = Sheet6

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        tmpAr = .Range("A1:A" & lRow).Value

        For i = LBound(tmpAr) To UBound(tmpAr)
            tmpAr(i, 1) = Replace(tmpAr(i, 1), "Units", "")
            tmpAr(i, 1) = Trim(Replace(tmpAr(i, 1), "Unit", ""))

            n = n + Val(tmpAr(i, 1))
        Next i

        ReDim Ar(t To n)

        n = 1

        For i = 1 To lRow
            If Len(Trim(.Range("A" & i).Value)) <> 0 Then
                k = Val(Trim(Replace(Replace(.Range("A" & i).Value, "Units", ""), "Unit", "")))

                For j = 1 To k
                    Ar(n) = .Range("B" & i).Value
                    n = n + 1
                Next j
            End If
        Next i

        For i = 1 To UBound(Ar)
            Debug.Print Ar(i)
        Next i
    End With
End Sub

Screenshot

截图

#3

if your data is already in an array then ReDim'ing will delete it's contents. You can ReDim Preserve but it's an expensive operation, better to create a new array to put the results into.

如果数据已经在数组中，那么重拨将删除它的内容。您可以重拨保存，但这是一个昂贵的操作，最好创建一个新的数组来放入结果。

I have assumed the data is contained within a Named Range called "Data" with Units being the first column and Values being the second column.

我假设数据包含在一个名为“data”的命名范围内，其中单元为第一列，值为第二列。

if your data changes regularly you can create a dynamic range using the OFFSET function i.e. =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),2) assuming your data starts in cell A1 and there is no header row.

如果你的数据经常发生变化，你可以使用抵消函数来创建一个动态范围，例如:=OFFSET(Sheet1!$ 1,0,0,COUNTA(Sheet1!$ a:$ a)，2)假设你的数据是从A1单元开始的，并且没有标题行。

Sub ProcessData()

    Dim DataArr() As Variant
    Dim QtyColArr() As Variant
    Dim ResultArr() As Variant
    Dim TotalQty As Long
    Dim i As Long, j As Long, k As Long

    'store data into array
    DataArr = Range("Data") 'assume data stored in named range called "Data"

    'store Qty col into 1D array
    QtyColArr = Range("Data").Resize(, 1)

    'sum all qty vals
    TotalQty = Application.Sum(QtyColArr)

    're-size ResultsArray
    ReDim ResultArr(1 To TotalQty)

    'Initialize ResultsArr counter
    k = LBound(ResultArr)

    'loop DataArr
    For i = LBound(DataArr) To UBound(DataArr)

        'loop qty for current row
        For j = 1 To DataArr(i, 1)

            'copy  value
            ResultArr(k) = DataArr(i, 2)

            'iterate ResultsArr counter
            k = k + 1

        Next j

    Next i

    'output to intermediate window
    Debug.Print "{" & Join(ResultArr) & "}"

End Sub