如何在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/.Activate 有趣的阅​​读

第二提示:

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

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洙

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部分.(谢谢Simoco).在这种情况下,您可以将代码编写为

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