『別シートからメインシートへコピー&挿入までのマクロについて』（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
また、「1つにまとめると必ずフリーズしてしまいます」は間違えています。
「永久(無限)ループ処理に忙しすぎて、応答する暇がありません」です。
それを解消するために、
For文や、Do〜Loopの間に、「DoEvents」をいれて、
「処理を一旦OSに渡す」という事をします。
例えば、繰り返し処理中に、Breakボタンが押されたとき、
OSに処理を渡すことで、Breakボタンが押されたかどうか判定できます。
しかし、繰り返し処理中にOSに処理を渡さないと、
Breakボタンが押されたかどうかの判断ができません。
(VBAのコード上でBreakボタンが押されたかを判断するコードがない)
従って、よく言われる「フリーズ」しているように見えているだけです。
（匿名） 2026/10/02(金) 12:21:08
まず、自動再計算をオフにして試して見てください。
疑問 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
当方でワークシートが見えるわけではないので、
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
（自分思考） 2026/10/03(土) 14:46:30
? さん 回答ありがとうございます。 B〜J列を削除後のF列、G列のことだと思ってましたので、矛盾が無いように思ってました。 質問に明記されていないので、どっちかわからないですね （´・ω・`） 2026/10/05(月) 08:28:18
□ChatGPT
Sub 確認表更新()
Dim wsC As Worksheet
Dim wsT As Worksheet
Dim lastRow As Long
Dim r As Long
Set wsC = Worksheets("確認表")
Set wsT = Worksheets("Template")
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo ErrHandler
'--------------------------------
'?@ 確認表の2〜4行のB:J、JI:JXを削除
'--------------------------------
wsC.Range("B2:J4").ClearContents
wsC.Range("JI2:JX4").ClearContents
'--------------------------------
'?A Templateの1〜3行を確認表へ挿入
'--------------------------------
wsT.Rows("1:3").Copy
wsC.Rows("1:3").Insert Shift:=xlDown
Application.CutCopyMode = False
'--------------------------------
'?B F列が「入場」かつG列が空欄でない行を検索
'--------------------------------
lastRow = wsC.Cells(wsC.Rows.Count, "F").End(xlUp).Row
r = 1
Do While r <= lastRow
If InStr(1, CStr(wsC.Cells(r, "F").Value), "入場", vbTextCompare) > 0 _
And wsC.Cells(r, "G").Value <> "" Then
'Template A5:JW18 は14行
wsC.Rows(r & ":" & r + 13).Insert Shift:=xlDown
'Template A5:JW18をコピー
wsT.Range("A5:JW18").Copy
wsC.Range("A" & r).PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
'挿入した14行分を飛ばす
r = r + 14
lastRow = lastRow + 14
End If
r = r + 1
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "確認表の更新が完了しました。", vbInformation
Exit Sub
ErrHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.CutCopyMode = False
MsgBox "エラーが発生しました。" & vbCrLf & _
"エラー番号：" & Err.Number & vbCrLf & _
"内容：" & Err.Description, vbExclamation
End Sub
□Copilot
Sub 確認表処理()
Dim wsK As Worksheet '確認表シート
Dim wsT As Worksheet 'Templateシート
Dim lastRow As Long
Dim i As Long
Set wsK = Worksheets("確認表")
Set wsT = Worksheets("Template")
'-----------------------------------------
'?@ 確認表シートの 2〜4行、B〜J列、JI〜JX列を削除
'-----------------------------------------
wsK.Range("B2:J4").ClearContents
wsK.Range("JI2:JX4").ClearContents
'-----------------------------------------
'?A Templateシートの 1〜3行を確認表シートに挿入
'-----------------------------------------
wsT.Rows("1:3").Copy
wsK.Rows("1:3").Insert Shift:=xlDown
'-----------------------------------------
'?B F列が「入場」かつ G列が空欄でない行に対して
' Templateシート A5〜JW18 をコピーして挿入
'-----------------------------------------
lastRow = wsK.Cells(wsK.Rows.Count, "F").End(xlUp).Row
For i = 1 To lastRow
If wsK.Cells(i, "F").Value = "入場" _
And wsK.Cells(i, "G").Value <> "" Then
wsT.Range("A5:JW18").Copy
wsK.Rows(i + 1).Insert Shift:=xlDown
End If
Next i
MsgBox "処理が完了しました。"
End Sub
（オアソビ） 2026/10/05(月) 22:05:58
（Bulls） 2026/10/07(水) 14:26:32
一度配列として取り込んで最後にシートに書き込んでください。
試してみます。
久々にマクロで作成したので、かなり苦しいですが挑戦します。
（Bulls） 2026/10/07(水) 14:28:45
作って頂いたマクロを解読しながら進めています。
大変勉強になります。
（Bulls） 2026/10/07(水) 14:30:50
（Bulls） 2026/10/07(水) 14:33:17
せっかく回答するなら （?） 2026/10/02(金) 18:33:13 さん （´・ω・`） 2026/10/05(月) 08:28:18 さん とかに回答すると多分誰かがvbaを書いてくれます。(たぶん)
私はvba嫌いなので関数ですが、 座標計算めんどくなったので9割方geminiです。
sheetnnn!A1 :=LET(
_wsSrc, TRIMRANGE(確認表!A1:ZZ1000,2,2),
_wsTemplate, template!A1:JW18,
__1,"不要行の削除 2:4行目を削除 ＝ 1行目 と 5行目以降を結合 ",
_delRow, VSTACK(TAKE(_wsSrc, 1), DROP(_wsSrc, 4)),
__2,"不要列の削除 {B:J列(2〜10列目)とJI:JX列(243〜258列目)を除外}",
_colMax, COLUMNS(_wsSrc),
_c1, CHOOSECOLS(_delRow, 1),
_c2, IF(_colMax>=11, CHOOSECOLS(_delRow, SEQUENCE(1, MIN(232, _colMax-10), 11)), ""),
_c3, IF(_colMax>=259, CHOOSECOLS(_delRow, SEQUENCE(1, _colMax-258, 259)), ""),
_delCol, IF(ISERR(_c2), _c1, IF(ISERR(_c3), HSTACK(_c1, _c2), HSTACK(_c1, _c2, _c3))),
__3, "Templateの1〜3行目を先頭 1行目 へ挿入",
_tempTop, TAKE(_wsTemplate, 3),
_baseData, VSTACK(_tempTop, _delCol),
__4, "テンプレートの挿入データを準備 A5:JW18の14行分",
_tempBody, DROP(_wsTemplate, 4),
__5, "ループ処理 REDUCEで1行ずつチェックしながら14行のテンプレートを差し込む",
_startIdx, 4,
_header, TAKE(_baseData, _startIdx),
_body, DROP(_baseData, _startIdx),
_result, REDUCE(_header, SEQUENCE(ROWS(_body)),
LAMBDA(_v,_idx,
LET(
_currentRow, CHOOSEROWS(_body, _idx),
__B,"J列の削除によって左に9列ズレるため、列間引き後のF列・G列＝元のO列・P列を正しく参照",
_f_val, TRIM(INDEX(_currentRow, 1, 6)),
_g_val, INDEX(_currentRow, 1, 7),
IF(AND(_f_val="入場", _g_val<>""),
VSTACK(_v, _currentRow, _tempBody),
VSTACK(_v, _currentRow)
)
)
)
),
_result
)
（ちくわ） 2026/10/07(水) 16:28:53
質問者さんへ あなたの質問の根幹は、↓ここだと思います。 > 別々でやると最後までできますが、1つにまとめると必ずフリーズしてしまいます。どこか間違っているのか教えていただけますでしょうか。 その問題に関しては、現状どのようにお考えなんですか？ 焦点を絞って議論を進めて下さい。
（ちくわ）さんの、以下の確認質問（2026/10/02(金) 19:12:04）をスルーする理由がわかりません。 問題解決に向け重要な事項かと思います。回答をしてもらえませんか？
| > 別々でやると最後までできます。 | っていうのは それぞれの処理objに分けて実行 ステップ実行 コメントアウトで実行 などのどれでしょう | | > 1つにまとめると必ずフリーズしてしまいます。 | フリーズであっていますか excelを閉じるとき応答してません と出るか | 電源落として再起動する必要が出てきますか。 | | もしマウスは動いてexcelの表示が変わらないだけであれば | Application.ScreenUpdating = False | が聞いているだけなので ループで挿入しているから重いだけの可能性が高いです。 | コメントアウトすれば動いているか確認できるので確かめてください。
ついでに、私の確認質問(2026/10/03(土) 14:36:47）にも回答してください。 > 条件にあう行はどのくらいあるのですか？(概算で結構です。）
もしも、コードの改善を希望しているのであれば、
シートの概要（レイアウト）や、作業の目的などをもう少し説明してください。
例："B:J"列の削除と、F:G列の状況に応じた行挿入の関係が不明ですし、
同じタイミングで行う必要があるのか戸惑います。
コードが正しい保証もないので、そういう基本的な説明は必要だと思います。
========== オアソビさん、AIの回答をそのままこちらに転送するのはやめて頂きたいです。 少なくとも、あなたがコードを確認したうえで、正常に動作すると思われるものを投稿してもらえませんか？ Copilotの回答は、今後の処理すべきセル範囲に挿入してしまうという、初歩的な誤りです。 海外のQ&Aサイトでは、こうした投稿が続出したために、AIの回答をそのまま投稿することは 大抵のところで禁止されています。
ただし、ご自身で実際に動作確認したうえ、AI回答を加工したと断り、ご自身が説明責任を負うつもりで 投稿されるのであれば問題ないのではないかと、私は考えています。
（xyz） 2026/10/07(水) 22:45:38
拒否します。
（ オアソビ） 2026/10/08(木) 09:55:02
■６
結局のところ、フリーズと表現されている事象は、再計算に時間がかかっていただけではないかと私を含めて複数人からコメントがありましたが、どうだったのでしょうか？
そちらが的を外しているのであれば↓では解決しないことになります。
Application.Calculation = xlCalculationManual '再計算を止める
■７
何らかの理由で再計算を止めたくないのですということであれば、元データは構わずに別に出力用のシートを用意し、そちらに値と書式を貼りつけるといった処理も一考の価値があるかと思います。
■８
配列に取り込んでから一気に出力するプランについて、高速化の手段としては有効だとおもいますが、セルの書式といった情報はコピーされません。
私見になりますが、まずは、現状の問題を解決されてからトライされたほうがいいのではないかと思います。
■９
＞Copilot先生にも聞いてみました。
＞気まぐれなのか…私が作成したコードと違うコードが返ってきました…。
余談になりますが、それでよいのではないかと思います。
正解は一つではありませんし、一番肝心なことは目的が達成できるかどうかでしょう。
さらにいうと、データが手元にない他者が代行してAIに聞いたものより、表のレイアウトなどが分かっているご自身がAIに聞いたものの方が確かである可能性すらあるとおもいます。
また、疑問に思ったところをAIに突っ込んで聞くことで確度が高められることも期待できます。
（もこな２） 2026/10/08(木) 21:01:32
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.