vba VBA正确循环数组
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/41373918/
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
VBA to correctly loop through an array
提问by Andes2016
I have read through a number of summaries of arrays but I am still lost and looking for much appreciated help. I have successfully created a non-array macro that copies a row in my ws and places below that parent row three copies. It does this for every row in the ws.
我已经通读了一些数组的摘要，但我仍然迷失了方向，正在寻找非常感谢的帮助。我已经成功创建了一个非数组宏，它复制了我的 ws 中的一行并在该父行下方放置了三个副本。它对 ws 中的每一行执行此操作。
eg
例如
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
There are > 4000 rows to loop through. My code works fine but it is slow. So I read that placing the ws into an array is better and then loop through the array. Here is where I am lost with arrays; how do I execute this copy and paste x 3 when I bring the ws into an array? I have written some code below but not sure how to execute this further. Many thanks.
有 > 4000 行要循环。我的代码工作正常，但速度很慢。所以我读到将 ws 放入数组更好，然后循环遍历数组。这是我迷失数组的地方；当我将 ws 放入数组时，如何执行此复制和粘贴 x 3？我在下面写了一些代码，但不确定如何进一步执行。非常感谢。
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
采纳答案by user3598756
Reading arrays is somewhat faster than reading cell values. The real performance gain is writing the data back to the worksheet.
读取数组比读取单元格值要快一些。真正的性能提升是将数据写回工作表。
As always I recommend watching Excel VBA Introductionon Youtube. This is the relevant video: Part 25 - Arrays
一如既往，我建议在 Youtube 上观看Excel VBA 介绍。这是相关视频：第 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
回答by user3598756
you could try this
你可以试试这个
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
which exploits this trickI knew from Thomas Inzina
回答by ThunderFrame
This code will be more flexible should you decide to alter the number of repetitions, or the number of columns that you want to have repeat with each row.
如果您决定更改重复次数或每行重复的列数，则此代码将更加灵活。
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
