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 INTERESTING 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部分。（谢谢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

如何在excel VBA中循环宏

1 个答案: