Question

由于我对面向对象语言和VBA缺乏了解，我需要在VBA中重现一些东西并且有点卡住。

问题：

我需要根据2列表生成数组或向量。
第一个范围（列）包含单位计数。
第二个范围（列）包含数值。

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

例如，

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

我理解这种情况将需要ReDim基于总值的数组。我的斗争是我无法弄清楚嵌套的for循环。

我得到了如何根据下面的“单位”数量复制价值......

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

循环到每一行的最佳方法是什么，并根据单位数复制范围中每行的值？

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

非常感谢任何帮助。感谢

Answer 1

或者使用REPT功能的一个班轮，就像你在r中使用的那样：）

这假设您的数据位于A1:B10 - 长度可以变为

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

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

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

Answer 2

当您说Row contains 3 units时，您的意思是该单元格的值为3还是3 Units？如果是3那么您可能不必在循环中Redim数组。只需在Col A中找到具有单位且Redim一次性的值的总和，如下所示。

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

<强>截图

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

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

<强>截图

Answer 3

如果您的数据已经在数组中，那么ReDim将删除它的内容。您可以ReDim Preserve，但这是一项昂贵的操作，最好创建一个新数组以将结果输入。

我假设数据包含在名为"Data"的命名范围内，Units是第一列，Values是第二列。

如果您的数据定期更改，您可以使用OFFSET函数创建动态范围，即=OFFSET(Sheet1!$A$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

循环以将值复制到数组

3 个答案: