循环将值复制到数组中
我处于一种需要在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）），并返回一个数组中的值。
任何帮助是极大的赞赏。 谢谢
或者使用REPT函数的一个class轮，就像你在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)
当你说Row contains 3 units ，你的意思是单元的值是3或3 Units ？ 如果是3那么你可能不需要在循环中Redim数组。 只需findCol 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上进行replace，find总和，最后使用上面的代码。 这是一个例子
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
截图
如果你的数据已经在数组中，那么ReDim将会删除它的内容。 你可以使用ReDim Preserve但这是一个昂贵的操作，最好创build一个新的数组来放置结果。
我假定数据被包含在名为"Data"的名称范围内，其中Units是第一列， Values是第二列。
如果数据定期更改，则可以使用OFFSET函数（即=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),2)来创builddynamic范围=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