如何在Excel VBA中循环一个macros

我想在Excel VBA中循环某个macros。 但是，我不知道该怎么做（我多次尝试失败）。 下面的代码中的注释是为了显示我想要做的事情。 代码，因为它是完美的，我只是希望它循环的每一个数据块，直到所有的数据已转换到第二个工作表（第一个工作表中包含大约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 (eg 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

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

第一提示：

请避免使用。select.Select/.Activate INTERESTING READ

第二个提示：

而不是自动填充，您可以一次性input相关单元格中的公式。 例如。 这个

 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 

编辑：

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

和

看到你的截图后，我猜这是你正在尝试？ 这是没有经过testing，因为我刚刚写了它。 让我知道如果你有任何错误:)

 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