Question

我已经阅读了一些数组的摘要，但我仍然迷失并寻找非常感谢的帮助。我已经成功创建了一个非数组宏，它在我的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

有＆gt;循环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

Answer 1

你可以试试这个

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那里了解到的this trick

Answer 2

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

我一如既往地建议在Youtube上观看Excel VBA Introduction。这是相关视频：Part 25 - Arrays

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 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

VBA正确循环数组

3 个答案: