时间戳

首页 > 解决方案 > 使用 VBA 在 excel 文件表之间进行循环

excel - 使用 VBA 在 excel 文件表之间进行循环

问题描述

我对 VBA 很陌生，有一个问题。对不起，如果这听起来很基本。我将不胜感激。我有一个包含 9 张工作表的 excel 文件（名称：总计、0、3、6、9、12、15、18、21）。首先，我想从工作表“0”、“3”、“6”、“9”、“12”、“15”、“18”、“21”按顺序复制每张工作表的第二行并粘贴它们在工作表“Total”的“A2:X2”到“A9:X9”行中。然后我想用第三行、第四行重复这个，直到第 365 行。

前两部分最简单的代码是这样的，但我想用 (for) 或任何其他东西将它写成一个循环，以使其易于使用。

Sub Copy_rows()
' copying the second rows:
Worksheets("0").Range("A2:X2").Copy Worksheets("Total").Range("A2:X2")
Worksheets("3").Range("A2:X2").Copy Worksheets("Total").Range("A3:X3")
Worksheets("6").Range("A2:X2").Copy Worksheets("Total").Range("A4:X4")
Worksheets("9").Range("A2:X2").Copy Worksheets("Total").Range("A5:X5")
Worksheets("12").Range("A2:X2").Copy Worksheets("Total").Range("A6:X6")
Worksheets("15").Range("A2:X2").Copy Worksheets("Total").Range("A7:X7")
Worksheets("18").Range("A2:X2").Copy Worksheets("Total").Range("A8:X8")
Worksheets("21").Range("A2:X2").Copy Worksheets("Total").Range("A9:X9")

'Copying the third rows:
Worksheets("0").Range("A3:X3").Copy Worksheets("Total").Range("A10:X10")
Worksheets("3").Range("A3:X3").Copy Worksheets("Total").Range("A11:X11")
Worksheets("6").Range("A3:X3").Copy Worksheets("Total").Range("A12:X12")
Worksheets("9").Range("A3:X3").Copy Worksheets("Total").Range("A13:X13")
Worksheets("12").Range("A3:X3").Copy Worksheets("Total").Range("A14:X14")
Worksheets("15").Range("A3:X3").Copy Worksheets("Total").Range("A15:X15")
Worksheets("18").Range("A3:X3").Copy Worksheets("Total").Range("A16:X16")
Worksheets("21").Range("A3:X3").Copy Worksheets("Total").Range("A17:X17")

End Sub

先感谢您。

标签： excelvbaloopscopy-paste

解决方案

逻辑

  1. 寻找趋势。例如工作表名称.. 0- 3- 6... 21。它增加3.
  2. 行数是固定的。2至365
  3. 不是在循环中复制，而是将值存储在一个数组中，然后一次性输出该数组。这将是超快的。
  4. 每张纸上有364行、列和总共有几张。因此，您需要带有列的行数组来存储数据。248364 * 824

代码

尝试这个。这段代码运行不到一秒钟。

Option Explicit

Sub Sample()
    Dim Ar As Variant
    Dim TotalRows As Long
    
    '~~> 364 rows per sheet * 8 sheets
    TotalRows = 364 * 8
    ReDim Ar(1 To TotalRows, 1 To 24)
    
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim rw As Long: rw = 1
    
    '~~> Loop through the rows
    For j = 2 To 365
        '~~> Loop through 8 worksheets from 0 to 21
        For i = 0 To 21 Step 3
            '~~> Loop through the columns
            For k = 1 To 24
                Ar(rw, k) = Worksheets(CStr(i)).Cells(j, k).Value
            Next k
            '~~> Increment row in array
            rw = rw + 1
      
        Next i
    Next j
    
    '~~> Output to total worksheet
    Worksheets("Total").Range("A2").Resize(UBound(Ar), 24).Value = Ar
End Sub

为了测试，我使用了这个Sample File。运行Sample代码Module1

推荐阅读