EXCELのマクロについて

質問

お世話になっております。

以下のマクロを1万行分繰り返したいのですが、回数を1万回と指定する構文を
教えてください。よろしくお願いします。

Sub Macro16()
'
' Macro16 Macro
'
' Keyboard Shortcut: Ctrl+Shift+Z
'
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(-1, 0).Range("A1:M1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 2).Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "7/5/1905"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "7/6/1905"
ActiveCell.Offset(1, -2).Range("A1").Select
End Sub

回答No.1

WindFaller · ベストアンサー

>以下のマクロを1万行分繰り返したいのですが、回数を1万回と指定する構文を教えてください。
どちらかと言うと、記録マクロでコードを一万回するのは無理がありますね。
本来は、どこにセルがあって、どこからどこまでコピーして、と書かれていたほうがよいです。

以下のマクロ（両方）は、アクティブセルの位置が重要になってきてしまいます。
アクティブセルの位置を間違えると、台無しになってしまうという問題があります。

本来、元のマクロは、記録マクロでも、相対参照の方式なので、分かりにくいし、失敗の可能性が出てきます。記録マクロで取る時は、なるべく絶対参照方式にしましょう。

'//
Sub Macro16R()
　Dim i As Long
　Dim myDate As Date
　myDate = #7/5/1905#　'これは日付と解釈しています。
　Application.ScreenUpdating = False
　Do
　　ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
　　Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
　　ActiveCell.Offset(-1, 0).Range("A1:M1").Select
　　Selection.Copy
　　ActiveCell.Offset(1, 0).Range("A1").Select
　　ActiveSheet.Paste
　　ActiveCell.Offset(-1, 2).Range("A1").Select
　　Application.CutCopyMode = False
　　ActiveCell.FormulaR1C1 = myDate + (i * 2)
　　ActiveCell.Offset(1, 0).Range("A1").Select
　　ActiveCell.FormulaR1C1 = myDate + (i * 2) + 1
　　ActiveCell.Offset(1, -2).Range("A1").Select
　　i = i + 1
　Loop Until i >= 10000　'1万回まで
　Application.ScreenUpdating = True
End Sub
'//

おまけ。私独自で試しに考えてみました。記録マクロとは大幅に違うことが分かると思います。
アクティブセルの列方向に、何かが書かれているという条件で、そのデータがある限りです。
そして、そのデータを別シート(右隣)にコピーする方式です。

'//
Sub TestMacro1()
　Dim sh As Worksheet
　Dim i As Long, j As Long
　With ActiveSheet
　　j = 1
　　Set sh = Worksheets.Add(After:=ActiveSheet)
　　Application.ScreenUpdating = False
　　For i = ActiveCell.Row To .Cells(Rows.Count, ActiveCell.Column).End(xlUp)
　　　.Cells(i, ActiveCell.Column).Resize(, 14).Copy sh.Cells(j, 1)
　　　.Cells(i, ActiveCell.Column).Resize(, 14).Copy sh.Cells(j + 1, 1)
　　　j = j + 2
　　Next i
　End With
　With sh
　　.Cells(1, 3).FormulaLocal = "1905/7/5"
　　.Cells(1, 3).AutoFill Destination:=.Range("C1", .Cells(Rows.Count, 3).End(xlUp)), Type:=xlFillDefault
　End With
　Application.ScreenUpdating = True
　Set sh = Nothing
End Sub
'//

お礼

詳細なご説明ありがとうございました。

回答No.2

mt2008

何をしたいのか良く解らなかったので、単純にMacro16を1万回実行するマクロを……
Sub Sample()
　　For i = 1 To 10000
　　　　Call Macro16
　　Next i
End Sub

お礼

ありがとうございました。