如何在excel VBA中循环宏

Question

我想在 excel VBA 中循环某个宏。但是，我不知道该怎么做（我尝试过多次但都失败了）。下面代码中的注释是为了显示我想要做什么。代码完美运行，我只希望它循环每个数据块，直到所有数据都转置到第二个工作表中（第一个工作表包含大约 5000 行数据，每 18 行必须转置为 1第二个工作表中的行）：

    Sub test()

' test Macro

Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-1]*100"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G19"), Type:=xlFillDefault
Range("G2:G19").Select
Range("A2:C2").Select
Selection.Copy
Sheets("Sheet2_Transposed data").Select
Range("A2").Select
ActiveSheet.Paste
    'I want to loop this for every next row until all data has been pasted (so A3, A4, etc.)
Sheets("Sheet1_session_data").Select
Range("G2:G19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2_Transposed_data").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
Range("D2:U2").Select
Application.CutCopyMode = False
    'Here I also want to loop for every next row until all data has been transposed and pasted (e.g. D3:U3, D4:U4 etc.)
Selection.NumberFormat = "0"
Sheets("Sheet1_session_data").Select
Rows("2:19").Select
Selection.Delete Shift:=xlUp
    ' Here I delete the entire data chunck that has been transposed, so the next chunck of data is the same selection. 

End Sub

希望这个问题可以理解，希望有人能提供帮助。 谢谢。

Answer 1

你实际上可以减少你的代码。

第一个提示：

请避免使用.Select/.ActivateINTERESTING READ

第二个提示：

您可以一次性在相关单元格中输入公式，而不是执行自动填充。例如。这个

Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-1]*100"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G19"), Type:=xlFillDefault

可以写成

Range("G2:G19").FormulaR1C1 = "=RC[-2]/RC[-1]*100"

第三个提示：

您无需在单独的行中进行复制和粘贴。您可以在一行中完成。例如

Range("A2:C2").Select
Selection.Copy
Sheets("Sheet2_Transposed data").Select
Range("A2").Select
ActiveSheet.Paste

可以写成

Range("A2:C2").Copy Sheets("Sheet2_Transposed data").Range("A2")

在执行 PasteSpecial 时也是如此。但是你用.Value = .Value soo 这个

Range("G2:G19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1_Transposed_data").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

可以写成

Sheets("Sheet1_Transposed_data").Range("D2:D19").Value = _
Sheets("Sheet1").Range("G2:G19").Value

错过了Transpose 部分。 （感谢西莫科）。在这种情况下，您可以将代码编写为

Range("A2:C2").Copy 
Sheets("Sheet2_Transposed data").Range("D2").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True

第四个提示：

要遍历单元格，您可以使用For Loop。假设你想循环单元格 A2 到 A20 那么你可以这样做

For i = 2 To 20
    With Range("A" & i)
        '
        '~~> Do Something
        '
    End With
Next i

编辑：

您之前和之后的屏幕截图（来自评论）：

和

看到你的截图后，我想这就是你正在尝试的？ 这是未经测试的，因为我刚写的很快。如果您遇到任何错误，请告诉我 :)

Sub test()
    Dim wsInPut As Worksheet, wsOutput As Worksheet
    Dim lRow As Long, NewRw As Long, i As Long

    '~~> Set your sheets here
    Set wsInPut = ThisWorkbook.Sheets("Sheet1_session_data")
    Set wsOutput = ThisWorkbook.Sheets("Sheet2_Transposed data")

    '~~> Start row in "Sheet2_Transposed data"
    NewRw = 2

    With wsInPut
        '~~> Find Last Row
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Calculate the average in one go
        .Range("G2:G" & lRow).FormulaR1C1 = "=RC[-2]/RC[-1]*100"

        '~~> Loop through the rows
        For i = 2 To lRow Step 18
            wsOutput.Range("A" & NewRw).Value = .Range("A" & i).Value
            wsOutput.Range("B" & NewRw).Value = .Range("B" & i).Value
            wsOutput.Range("C" & NewRw).Value = .Range("C" & i).Value

            .Range("G" & i & ":G" & (i + 17)).Copy

            wsOutput.Range("D" & NewRw).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=True

            NewRw = NewRw + 1
        Next i

        wsOutput.Range("D2:U" & (NewRw - 1)).NumberFormat = "0"
    End With
End Sub