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" 

세 번째 팁과 같이 쓸 수있다. 한 줄로 처리 할 수 ​​있습니다. 당신이 PasteSpecial을하고 예를 들어

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") 

로 같은 일을 쓸 수 있습니다. 하지만 당신은 한혜진이

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 

가 Transpose 부분을 누락

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

과 같이 쓸 수있다 .Value = .Value를 사용합니다. (감사 Simoco). 반복하려면

세포를 통해, 당신은 For Loop을 사용할 수 있습니다 :이 경우

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

네 번째 팁으로 코드를 작성할 수 있습니다.(을 댓글에서 ) 귀하의 전

및 스크린 샷 후 : 당신이 세포 A2A20에 다음이

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