在 excel 文件的工作表之间使用 VBA 进行循环

Question

我是 VBA 的新手，有一个问题。对不起，如果这听起来很基础。我将不胜感激任何帮助。我有一个包含 9 个 sheet 的 excel 文件（名称：Total、0、3、6、9、12、15、18、21）。首先，我想从 sheets "0", "3", "6", "9", "12", "15", "开始依次复制每个 sheet 的第二行18”、“21”并将它们粘贴到 sheet“总计”的“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

提前致谢。

Answer 1

试试这个：

Dim Index As Integer

    Index = 2
    For i = 2 To 365
        Worksheets("0").Range("A" & i & ":X" & i).Copy(Worksheets("Total").Range("A" & Index & ":X" & Index))
        Worksheets("3").Range("A" & i & ":X" & i).Copy(Worksheets("Total").Range("A" & Index + 1 & ":X" & Index + 1))
        Worksheets("6").Range("A" & i & ":X" & i).Copy(Worksheets("Total").Range("A" & Index + 2 & ":X" & Index + 2))
        Worksheets("9").Range("A" & i & ":X" & i).Copy(Worksheets("Total").Range("A" & Index + 3 & ":X" & Index + 3))
        Worksheets("12").Range("A" & i & ":X" & i).Copy(Worksheets("Total").Range("A" & Index + 4 & ":X" & Index + 4))
        Worksheets("15").Range("A" & i & ":X" & i).Copy(Worksheets("Total").Range("A" & Index + 5 & ":X" & Index + 5))
        Worksheets("18").Range("A" & i & ":X" & i).Copy(Worksheets("Total").Range("A" & Index + 6 & ":X" & Index + 6))
        Worksheets("21").Range("A" & i & ":X" & i).Copy(Worksheets("Total").Range("A" & Index + 7 & ":X" & Index + 7))
        Index = Index + i + 5
    Next

Answer 2

逻辑

寻找趋势。例如工作sheet 姓名.. 0-3-6...21。它递增 3.
行数是固定的。 2 至 365
与其在循环中复制，不如将值存储在一个数组中，然后一次性输出该数组。它将是超快。
每个 sheet 有 364 行，24 列，总共 8 sheet 秒。因此，您需要 364 * 8 行数组和 24 列来存储数据。

代码

试试这个。此代码用了 不到一秒 到运行。

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。运行 Module1

中的代码 Sample

Answer 3

As-salamualaikum，阿明；

这是一个很棒的平台，随时欢迎您。

希望我已经正确理解了你的问题，这里是针对你的具体问题的代码。

Sub copyData()

    Dim mySheets As Variant, r As Long, _
        sh As Variant, lastRow As Long
    
    mySheets = Array("0", "3", "6", "9", "12", "15", "18", "21")
    
    lastRow = 2
    
    For r = 2 To 365
        For Each sh In mySheets
            sheets(sh).Range("A" & r & ":X" & r).Copy _
                sheets("total").Cells(lastRow, 1)
            lastRow = sheets("total").Cells(Rows.Count, 1).End(xlUp).Row + 1
        Next sh
    Next r

End Sub

我已尽力使代码对您而言尽可能简单。快乐编码...

在 excel 文件的工作表之间使用 VBA 进行循环

Using VBA for a cycle loop between sheets of an excel file

excel

vba

loops

copy-paste