我要遍历大量数据-确切地说是5,734行。这是我要对所有行执行的操作:
Private Sub CommandButton1_Click()
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row
Range("A2:A14").Copy Range("D2:D14")
("B2:B14").Copy Range("D15:D27")
Range("C2:C14").Copy Range("D28:D40")
假设您的数据看起来像这样(颜色可以更容易地显示组):
以下代码将每个组(黄色,绿色)粘贴到“结果”列中。
码:
Option Explicit
Sub copy_paste()
Dim lrow As Long
Dim i As Long
Dim j As Long
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Sheet1") 'Set the name of the sheet
lrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'Find the last row in column A
For i = 2 To lrow Step 13 'Loop every group (group of 13 rows) in column A
For j = 1 To 13 Step 13 'For each group, copy and paste
ws.Cells(i, "A").Resize(13).Copy ws.Cells(Rows.Count, "D").End(xlUp).Offset(1, 0) 'Copy the group and paste it to the column D. Offset by one to not overwrite the last row
ws.Cells(i, "B").Resize(13).Copy ws.Cells(Rows.Count, "D").End(xlUp).Offset(1, 0)
ws.Cells(i, "C").Resize(13).Copy ws.Cells(Rows.Count, "D").End(xlUp).Offset(1, 0)
Next j
Next i
End Sub
结果:
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句