[[20261002104950]]　『別シートからメインシートへコピー&挿入までのマメx（Bulls）　ページの最後に飛ぶ

『別シートからメインシートへコピー&挿入までのマクロについて』（Bulls）

確認表シートの2～4行、B～J列、JI～JX列を削除
Templateシートの1～3行を確認表シートに挿入
確認表シートF列に「入場」文字があることとG列に空欄でなければ、TemplateシートにあるA5～JW18をコピー&挿入する命令文を作りました。

別々でやると最後までできますが、1つにまとめると必ずフリーズしてしまいます。どこか間違っているのか教えていただけますでしょうか。

よろしくお願いいたします。

/*---------------------------------------------------------*?

Sub MainProcess()

    Dim ws As Worksheet
    Dim wsTemplate As Worksheet
    Dim LastRow As Long
    Dim i As Long
    Dim InsertRow As Long

    Set ws = Sheets("確認表")
    Set wsTemplate = Sheets("Template")

    Application.ScreenUpdating = False

    '不要行削除
    ws.Rows("2:4").Delete

    '不要列削除
    ws.Columns("JI:JX").Delete
    ws.Columns("B:J").Delete

    'Templateの1～3行を先頭へコピー
    wsTemplate.Rows("1:3").Copy
    ws.Rows("1").Insert Shift:=xlDown

    Application.CutCopyMode = False

    'テンプレート挿入処理
    LastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row

    For i = LastRow To 1 Step -1

        If Trim(ws.Cells(i, "F").Value) = "入場" And _
           ws.Cells(i, "G").Value <> "" Then

            InsertRow = i + 4

            '14行挿入
            ws.Rows(InsertRow & ":" & InsertRow + 13).Insert

            'TemplateシートのA5:JW18を貼付
            wsTemplate.Range("A5:JW18").Copy
            ws.Range("A" & InsertRow).PasteSpecial xlPasteAll

        End If

    Next i

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

    MsgBox "完了しました"

End Sub

＜使用 Excel：unknown、使用 OS：unknown ＞

バージョンによって回答が異なるので必ずバージョンを書いた方がいいですよ。
（?） 2026/10/02(金) 11:20:44

適当なところに
doevevs
でも入れておけばいいんじゃいですかね？
因みにスペル忘れていますので
その辺は調べてください
（痴呆） 2026/10/02(金) 11:31:45

F5で1行ずつ実行しながら動きを見てはどうでしょうか。

また、「1つにまとめると必ずフリーズしてしまいます」は間違えています。
「永久(無限)ループ処理に忙しすぎて、応答する暇がありません」です。

それを解消するために、
For文や、Do～Loopの間に、「DoEvents」をいれて、
「処理を一旦OSに渡す」という事をします。

例えば、繰り返し処理中に、Breakボタンが押されたとき、
OSに処理を渡すことで、Breakボタンが押されたかどうか判定できます。
しかし、繰り返し処理中にOSに処理を渡さないと、
Breakボタンが押されたかどうかの判断ができません。
(VBAのコード上でBreakボタンが押されたかを判断するコードがない)
従って、よく言われる「フリーズ」しているように見えているだけです。

（匿名） 2026/10/02(金) 12:21:08

↑間違えました、
F5ではなく、F8でした。すみません。
（匿名） 2026/10/02(金) 12:21:40

文章通りのマクロになっていません。
（?） 2026/10/02(金) 15:37:48

 まず、自動再計算をオフにして試して見てください。

 疑問
   InsertRow = i + 4
 はこれでいいですか？
   InsertRow = i + 1
 にしないとだめじゃないですかね？

 最初に
    ws.Rows("2:4").Delete
 して、３行上にずれているの、計算にいれてますか？
（´・ω・`） 2026/10/02(金) 16:01:04

(匿名)さん

アドバイスありがとうございます。
一度、For文にDoEventsを入れましたが、改善は見られませんでした。
Loopつかってないからか…。

実は9月下旬にマクロやり始めた(15年ぶりに…)ので、思い出しながら作っています。
ど素人レベルなので…愚問でしたらすみません。
（Bulls） 2026/10/02(金) 16:14:30

（´・ω・`）さん

確認表シートの2~4行目を削除して、templateシートの1~3行目をコピー&挿入しているので間違いないと思っています。

（Bulls） 2026/10/02(金) 16:20:18

文章通りのマクロになっていません。
（?） 2026/10/02(金) 16:26:41

 当方でワークシートが見えるわけではないので、
    InsertRow = i + 4
 で正しいというならそれでよいです。
 自動再計算をOFFにして実行した結果をおしららせください。

 ? さん
 >文章通りのマクロになっていません。
 どのあたりのことですか？　具体的に書いてもらうと助かります。
 私は説明どおりだと思いました。
（´・ω・`） 2026/10/02(金) 16:38:06

 (発言を取り下げます。)
（xyz） 2026/10/02(金) 17:34:02

＞どのあたりのことですか？

＞確認表シートの2～4行、B～J列、JI～JX列を削除
「確認表シートF列に「入場」文字があることとG列」は削除範囲にあること。

ws.Columns("B:J").Delete

If Trim(ws.Cells(i, "F").Value) = "入場" And _

   ws.Cells(i, "G").Value <> "" Then

列を対称にしているのでこれで正しく動作しますか。

違っていたらすみません。

（?） 2026/10/02(金) 18:33:13

 元データのシートに削除や挿入するのはどうなのかと思いますけど

 > 別々でやると最後までできます。
 っていうのは それぞれの処理objに分けて実行 ステップ実行 コメントアウトで実行 などのどれでしょう

 > 1つにまとめると必ずフリーズしてしまいます。
 フリーズであっていますか excelを閉じるとき応答してません と出るか
 電源落として再起動する必要が出てきますか。

 もしマウスは動いてexcelの表示が変わらないだけであれば 
   Application.ScreenUpdating = False
 が聞いているだけなので ループで挿入しているから重いだけの可能性が高いです。
　コメントアウトすれば動いているか確認できるので確かめてください。

 高速化するなら
 一度配列として取り込んで最後にシートに書き込んでください。

 確認表シートに数式入ってるなら
 （´・ω・`）さんの
 > 自動再計算をオフにして試して見てください。

 が最も影響あると思います。。

（ちくわ） 2026/10/02(金) 19:12:04

私も横からですが何点か。

■１
既に指摘があるところですが、例えばLOOKUP系の参照が大量にあって行の削除や挿入（貼付けを含む）のたびに再計算が走っていてべらぼうに時間がかかっているとかはないでしょうか？

■２
大差はないとおもいますが、IF分岐のところは入れ子にした方が理屈上は早いということになると思います。

 If Trim(ws.Cells(i, "F").Value) = "入場" And ws.Cells(i, "G").Value <> "" Then
　　　～～～処理～～～
 End If

 If Trim(ws.Cells(i, "F").Value) = "入場" Then
     If ws.Cells(i, "G").Value <> "" Then
　　　～～～処理～～～
     End If
 End If

前者は、1つ目の条件が偽になるときでも2つ目の条件の評価を行いますが、後者は1つ目の条件が偽になるときは2つ目の評価はそもそも行いません。

■３
表のレイアウトがわからないので何ともいえないのですが、以下はそれぞれ上書き貼付けや、セル範囲の挿入で対応できないのかな？と疑問に思いました。

    ws.Rows("2:4").Delete
    wsTemplate.Rows("1:3").Copy
    ws.Rows("1").Insert Shift:=xlDown

    ws.Rows(InsertRow & ":" & InsertRow + 13).Insert
    wsTemplate.Range("A5:JW18").Copy
    ws.Range("A" & InsertRow).PasteSpecial xlPasteAll

■４
以下は、工夫すればまとめられます。

 ws.Columns("JI:JX").Delete
 ws.Columns("B:J").Delete

■５
ということをふまえて、↓のようにするのも手かなとおもいました。

    Sub 整理()
        Dim wsTemplate As Worksheet
        Dim LastRow As Long
        Dim i As Long

        Set wsTemplate = Sheets("Template")

        Application.Calculation = xlCalculationManual '再計算を止める

        With Sheets("確認表")
            '不要列の削除
            .Range("B:J,JI:JX").Delete

            'Templateの1～3行を確認表の2～4行に（上書き）貼り付け先頭へコピー
            wsTemplate.Rows("1:3").Copy .Rows(2)

            '最終行取得
            LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row

            For i = LastRow To 1 Step -1

                If Trim(.Cells(i, "F").Value) = "入場" Then
                    If .Cells(i, "G").Value <> "" Then

                        'TemplateシートのA5:JW18を確認表の該当箇所に挿入（して下にシフトさせる）
                        wsTemplate.Range("A5:JW18").Copy
                        .Cells(i, "A").Insert Shift:=xlDown
                    End If
                End If

            Next i
        End With

        Stop  'ブレークポイントの代わり
        Application.Calculation = xlCalculationAutomatic '自動計算にもどす
    End Sub

（もこな２） 2026/10/02(金) 19:36:44

F、G列を削除しているので、F、G列の値を見つけられないため無限ループになっているのではないでしょうか。

（自分思考） 2026/10/03(土) 09:34:04

 自分思考さん、こんにちは。
 For i = LastRow To 1 Step -1　という固定の行のループですので、無限ループにはならないと思います。
 仮に、「その行のF列が"入場"で、G列になんらかのものが入力されている」の条件を満たすものが
 何も無ければ、瞬時にプロシージャは終了すると思います。

 質問者さんへ。（すでに（ちくわ）さんから指摘されていることですが、あえて書きます）
 画面更新を抑止することと、フリーズすることは全く別のことですが、そこは理解されていますね？
 （私見では、画面更新を止めずに実行しても、それが原因でそれほど極端に遅くはならない気がします。）

 条件にあう行はどのくらいあるのですか？(概算で結構です。）
 もし数百程度であれば、少し待てば処理は終了するのではないですか？
 数式を多用しているシートであれば、手動計算にして処理実行、終了してから自動計算に戻すと
 処理時間を短縮できると思います。

（xyz） 2026/10/03(土) 14:36:47

＞条件を満たすものが何も無ければ、瞬時にプロシージャは終了すると思います。
なるほどそういうことですね。理解しました。
（xyz）さん補足有難う。

（自分思考） 2026/10/03(土) 14:46:30

コメント返信：

[ 一覧(最新更新順) ]

[[20261002104950]] 『別シートからメインシートへコピー&挿入までのマメx（Bulls） ページの最後に飛ぶ

[[20261002104950]]　『別シートからメインシートへコピー&挿入までのマメx（Bulls）　ページの最後に飛ぶ