VBA正确循环一个数组

我已经阅读了一些数组的摘要，但我仍然失去了，寻求非常感谢的帮助。 我已经成功地创build了一个非数组macros，它在我的ws中复制了一行，并在这个父行的下面放置了三个副本。 它为ws中的每一行做了这个。

例如

From: ColA ColB Tom Tent Barry Stove To: ColA ColB Tom Tent Tom Tent Tom Tent Tom Tent Barry Stove Barry Stove Barry Stove Barry Stove 

有> 4000行循环。 我的代码工作正常，但速度很慢。 所以我读了把ws放到一个数组中更好，然后遍历数组。 这是我失去arrays的地方; 我如何执行这个副本，并粘贴x 3时，我把ws放入一个数组？ 我已经在下面写了一些代码，但不知道如何进一步执行。 非常感谢。

 Sub LoadDataintoArray() Dim StrArray As Variant Dim TotalRows As Long TotalRows = Rows(Rows.Count).End(xlUp).Row StrArray = Range(Cells(1, 1), Cells(TotalRows, 1)).Value MsgBox "Loaded " & UBound(StrArray) & " items!" 'HERE I NOW WISH TO COPY EACH ROW IN THE WS (EXCEPT HEADER) AND PASTE THREE COPIES OF THAT ROW IMMEDIATELY BELOW THE PARENT ROW 'CODE I USED NOT USNG AN ARRAY IS BELOW ' ' lRow = 2 ' Do While (Cells(lRow, "B") <> "") ' ' RepeatFactor = 4 ' ' Range(Cells(lRow, "A"), Cells(lRow, "G")).Copy ' ' Range(Cells(lRow + 1, "A"), Cells(lRow + RepeatFactor - 1, "G")).Select ' ' Selection.Insert Shift:=xlDown ' ' lRow = lRow + RepeatFactor - 1 ' ' lRow = lRow + 1 ' Loop ' End Sub 

Answer 1

读取数组比读取单元格的值要快一些。 真正的性能增益是将数据写回工作表。

一如既往，我build议您观看Youtube上的Excel VBA简介 。 这是相关的video： 第25部分 – 数组

 Sub RepeatData() Dim Data As Variant, Data1 As Variant Dim x As Long, x1 As Long, x2 As Long, y As Long Data = Range("A2:G2", Range("B" & Rows.Count).End(xlUp)) ReDim Data1(1 To UBound(Data, 1) * 4, 1 To UBound(Data, 2)) For x = 1 To UBound(Data, 1) For x1 = 1 To 4 x2 = x2 + 1 For y = 1 To UBound(Data, 2) Data1(x2, y) = Data(x, y) Next Next Next Range("A2:G2").Resize(UBound(Data1, 1)).Value = Data1 End Sub 

Answer 2

你可以试试这个

 Option Explicit Sub Main() Dim Data As Variant Dim x As Long With Range("A2:G2", Range("B" & Rows.count).End(xlUp)) Data = .Value For x = 1 To UBound(Data, 1) .Rows(4 * (x - 1) + 1).Resize(4) = Application.index(Data, x, 0) Next End With End Sub 

它利用了我从托马斯·因齐纳（Thomas Inzina）那里知道的这个把戏

Answer 3

如果您决定更改重复次数，或者希望每行重复一次的列数，则此代码将更加灵活。

 Sub test1() 'Set your input range to include all of the rows and all of the columns to repeat Dim StrArray As Variant StrArray = Range("A2:B5") Const numRepeats As Long = 4 Const outputColumnStart As Long = 4 Dim rowCounter As Long Dim colCounter As Long 'Dimension a new array and populate it ReDim newArray(LBound(StrArray, 1) To UBound(StrArray, 1) * numRepeats, LBound(StrArray, 2) To UBound(StrArray, 2)) For rowCounter = LBound(StrArray, 1) To UBound(StrArray, 1) Dim repeatCounter As Long For repeatCounter = 0 To numRepeats - 1 For colCounter = LBound(StrArray, 2) To UBound(StrArray, 2) newArray(((rowCounter - 1) * numRepeats + 1) + repeatCounter, colCounter) = StrArray(rowCounter, colCounter) Next colCounter Next Next rowCounter 'Write the values to the sheet in a single line. With ActiveSheet .Range(.Cells(1, 4), .Cells(UBound(newArray, 1), outputColumnStart + UBound(newArray, 2) - 1)).Value = newArray End With End Sub