ほぼテク2月9日引き継ぎゼロのExcel VBAを“仕様化”して蘇らせる。ChatGPTに投げるだけで保守不能マクロが読めるようになるプロンプト解説。

ChatGPT VBA 保守Excel マクロ解析保守不能マクロVBA リファクタリング仕様書自動生成業務効率化 AI引き継ぎなしマクロVBA ブラックボックスマクロ危険箇所VBA コードレビュー

2月9日

著者裕太我妻

はじめに

本日もよろしくお願いします。
今回は「Excel VBAの保守不能マクロを、ChatGPTで仕様化して“保守できる状態”に戻すプロンプト」について解説します。

Excelの現場では、ある日突然こうなります。
「出向者が作ったマクロが残っている。
でも誰も仕様を知らない。
動くけど怖くて触れない。」
この状態、かなり多いです。

そして、怖いのは“動くこと”です。
動いてしまうから、誰も止められない。
止められないから、誰も直せない。
直せないから、ずっと同じ事故が起きる。
この負のループが回り続けます。

そこで効くのが、今回のプロンプトです。
ポイントは「VBAを読める人向けの説明」ではなく「業務側も読める仕様書っぽい出力」をChatGPTに要求しているところです。

つまり、コードの解説だけでは終わらない。
処理フロー。
入出力。
副作用。
危険箇所。
改善案。
読みやすい改善版コード。
ここまで一気に作らせる。
これが“保守復活”の最短ルートになります。

よくある課題

ここからは、現場で頻発する「保守不能VBA」の典型的な課題を、体感に寄り添って整理します。

課題1。仕様が誰の頭にも残っていない。
VBAの怖さは、仕様がExcelの中に閉じ込められやすい点です。
要件定義書が無い。
設計書が無い。
コメントも無い。
あるのは“動くコードだけ”。
これが一番危険です。

そして引き継ぎがないと、現場は次の状態になります。
何を入力にしているのか分からない。
どのシートを消しているのか分からない。
どんな条件で除外しているのか分からない。
集計キーが何なのか分からない。

でも数字は出てくる。
怖い。
触れない。
終わり。

課題2。副作用が多すぎて事故が起きる。
VBAは簡単に消せます。
Cells.Clear。
CurrentRegion.Clear。
これが入っているだけで、ワンクリックで“取り返しのつかない空白”が生まれます。

しかも、警告を消しているコードも多いです。
つまり、ユーザーは「消していいですか？」すら聞かれず消されます。

さらに、次のような外部依存も危険です。
特定シート名が前提。
特定列順が前提。
ヘッダの表記揺れで挙動が変わる。
シートが無いと勝手に追加する。
ログを書いているつもりで書けていない。
こういう“見えない地雷”が積み重なります。

課題3。エラーが握りつぶされて、間違っていても気づけない。
On Error Resume Next。
これは最強に危険です。
なぜなら、失敗しても失敗したことにならないからです。

たとえば、列の特定に失敗した。
辞書参照に失敗した。
日付変換に失敗した。
それでも処理は進みます。
結果も出ます。
でも中身は壊れている可能性があります。

現場が一番嫌うのは、こういう状態です。
「正しいかどうか分からない数字が、正しい顔で出てくる。」
これが保守不能の核心です。

課題4。改善しようにも、どこから触ればいいか分からない。
よくある流れはこうです。
一部だけ直す。
別のところが壊れる。
怖くて元に戻す。
結局、放置。
その間に担当者が異動。
さらにブラックボックス化。

ここで必要なのは、いきなりリファクタリングではありません。
まず“見える化”です。
今の処理は何をしているのか。
何を入力にして、何を出力にしているのか。
どこに危険があるのか。
ここを文章で説明できる状態にする。
それが最初の勝ち筋です。

解決ChatGPT

では、今回のプロンプトが何をしているのか。
ここが一番大事です。

あなたがやりたいのは、ChatGPTに「コードレビュー」をさせることではありません。
ChatGPTに「保守できる形に翻訳」させることです。

そのために、プロンプトは次の“命令セット”になっています。

3-1。目的を明確に固定している。
目的が素晴らしいです。
次の5点が揃うと、出力が一気に実務寄りになります。
処理内容を日本語で分かりやすく解説。
処理フローをステップ化。
入力/出力/副作用を明示。
危険な処理を指摘。
リファクタリング案を提示。
コメント付き改善版コードを再生成。

ここでの勝ちポイントは「副作用」と「危険な処理」を明示させている点です。
単なる説明だと、ChatGPTは“読める風の要約”で終わります。
でも副作用が入ると、出力が設計レビューに近づきます。
保守の第一歩は、まさにここです。

3-2。出力形式を固定している。
これが超重要です。
人間がコードを読むときは、自然に次の順番で理解します。
何の機能か。
どう流れるか。
何が入って何が出るか。
何が危ないか。
どう直すか。
改善版はどうなるか。

だからプロンプトが、最初からこの順序を指定している。
①機能概要。
②処理フロー。
③入出力一覧表。
④問題点・リスク。
⑤改善提案。
⑥改善後コード。
この並びは、保守に必要な理解の順番そのものです。

つまり、出力が“読むための文章”になる。
これだけで現場の心理的ハードルが一気に下がります。

3-3。ChatGPTに「保守専門エンジニア」のロールを与えている。
これも効きます。
同じコードでも、ロールが違うと見る観点が変わります。
開発者ロールなら「動けばOK」で話しがちです。
でも保守ロールなら「壊れないか。
事故らないか。
変更に耐えるか。」を見ます。

特にVBAは、利用者が非エンジニアであることが多いです。
だからこそ保守目線は重要です。
安全に戻せる。
実行前にチェックする。
ログを残す。
こういう思想が出力に反映されます。

3-4。ブラックボックスの“疑わしさ”もそのまま出力させている。
今回の入力コードには、わざとらしいほどの地雷が入っています。
ヘッダ推定が当たる時も外れる時もある。
見つからないと決め打ち。
日付が不正なら今日にする。
On Error Resume Nextで黙る。
シートの全消去。
Reportへ突然転記。

こういう箇所は、仕様が分からない以上“断言”できません。
でも保守では断言しない勇気が必要です。
だからプロンプトが「仕様不明でも、危険・外部依存・上書きなどを指摘しろ」と求めている。
これにより、ChatGPTは“分からないものは分からないまま危険として扱う”という、安全な姿勢を取りやすくなります。

3-5。改善版コードまで作らせているのが強い。
多くの人が、説明だけで止めます。
でも現場で本当に欲しいのは、動く改善案です。
コメントが付いていて。
構造が整理されていて。
エラー処理がまともで。
設定が戻るようになっていて。
危険操作に注意が入っている。

これを一回の対話で出せるのは、ChatGPTの強みです。
もちろん、そのまま本番投入は危険です。
でも“叩き台”としては破格です。
叩き台があるだけで、人間が確認すべきポイントが明確になります。

さっそくやってみよう！

【ルール】
・ChatGPTで実験する
・ChatGPTでExcel VBAの保守不能マクロを仕様化して“保守できる状態にする

【プロンプト】

あなたは「Excel VBAの保守専門エンジニア」です。
以下のマクロは、出向者が作成し引き継ぎ無しで残されたものです。
現在、誰も仕様が分からず保守不能状態です。

【目的】

処理内容を日本語で分かりやすく解説
処理フローをステップ
入力/出力/副作用を明示
危険な処理（削除/上書き/外部依存）を指摘
リファクタリング案を提示
コメント付きの「読みやすい改善版コード」を再生成

【出力形式】
① 機能概要
② 処理フロー（番号付き）
③ 入出力一覧表
④ 問題点・リスク
⑤ 改善提案
⑥ 改善後のVBAコード（フルコード）

【VBAコード】
Option Explicit

Sub __x1()

On Error Resume Next

Dim a, b, c, d, e, f, g, h, i, j, k, m, n, p, q, r, s, t, u, v

Dim ws, ws2, ws3, ws4

Dim rng, rng2

Dim lastRow As Long, lastCol As Long

Dim key As String, tmp As String, tmp2 As String

Dim arr, arr2

Dim dict As Object, dict2 As Object

Dim st As Double, ed As Double

st = Timer

Application.ScreenUpdating = False

Application.EnableEvents = False

Application.DisplayAlerts = False

Application.Calculation = xlCalculationManual

Set ws = ThisWorkbook.Sheets("Raw")

Set ws2 = ThisWorkbook.Sheets("Master")

Set ws3 = ThisWorkbook.Sheets("Work")

If SheetExists("Log") Then

Set ws4 = ThisWorkbook.Sheets("Log")

Else

Set ws4 = ThisWorkbook.Sheets.Add(After:=ws3)

ws4.Name = "Log"

ws4.Range("A1:E1").Value = Array("ts", "step", "msg", "x", "y")

End If

ws4.Cells(ws4.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 3).Value = Array(Now, "start", "go")

' --- なぜか最初にゴミ掃除 ---

ws3.Cells.Clear

ws3.Range("A1").Value = "tmp"

lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

If lastRow < 2 Then GoTo FIN

' --- ヘッダ行を勝手に推定（当たる時もあるし外れる時もある） ---

Dim colCode As Long, colName As Long, colDate As Long, colQty As Long, colPrice As Long, colDept As Long, colFlag As Long

colCode = FindCol(ws, Array("コード", "品目コード", "ITEM", "ItemCode", "商品CD"))

colName = FindCol(ws, Array("名称", "品目名", "ITEMNAME", "ItemName"))

colDate = FindCol(ws, Array("日付", "取引日", "DATE", "Date"))

colQty = FindCol(ws, Array("数量", "QTY", "Qty", "個数"))

colPrice = FindCol(ws, Array("単価", "価格", "PRICE", "Price"))

colDept = FindCol(ws, Array("部署", "部門", "DEPT", "Department"))

colFlag = FindCol(ws, Array("フラグ", "FLAG", "状態", "Status"))

' --- 見つからないと勝手に決め打ち（地獄） ---

If colCode = 0 Then colCode = 1

If colName = 0 Then colName = 2

If colDate = 0 Then colDate = 3

If colQty = 0 Then colQty = 4

If colPrice = 0 Then colPrice = 5

If colDept = 0 Then colDept = 6

If colFlag = 0 Then colFlag = 7

' --- Rawを配列へ（高速だけど、その後が地獄） ---

arr = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value

Set dict = CreateObject("Scripting.Dictionary")

Set dict2 = CreateObject("Scripting.Dictionary")

' --- Masterを辞書化（ただしキー仕様が謎） ---

Dim mLast As Long, mcCode As Long, mcRate As Long, mcTax As Long, mcAlias As Long, mcGrp As Long

mLast = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row

mcCode = FindCol(ws2, Array("コード", "品目コード", "ITEM", "ItemCode"))

mcRate = FindCol(ws2, Array("レート", "Rate", "係数"))

mcTax = FindCol(ws2, Array("税", "Tax", "TAX"))

mcAlias = FindCol(ws2, Array("別名", "Alias", "名称補正"))

mcGrp = FindCol(ws2, Array("分類", "Group", "カテゴリ"))

If mcCode = 0 Then mcCode = 1

If mcRate = 0 Then mcRate = 2

If mcTax = 0 Then mcTax = 3

If mcAlias = 0 Then mcAlias = 4

If mcGrp = 0 Then mcGrp = 5

For i = 2 To mLast

key = Trim(CStr(ws2.Cells(i, mcCode).Value))

If key <> "" Then

If Not dict2.Exists(key) Then

dict2.Add key, Array(ws2.Cells(i, mcRate).Value, ws2.Cells(i, mcTax).Value, ws2.Cells(i, mcAlias).Value, ws2.Cells(i, mcGrp).Value)

End If

' --- 出力ヘッダ（急にそれっぽくなる）---

ws3.Range("A1:O1").Value = Array("K", "Code", "Name", "Date", "Qty", "Price", "Amount", "Dept", "Flag", "Rate", "Tax", "AdjName", "Group", "Memo", "Hash")

Dim outRow As Long: outRow = 2

' --- 本処理：分岐が雑多で意味不明 ---

Dim rate, tax, aliasName, grp

Dim dt, qty, price, amt

Dim dept, flag

Dim memo As String, hh As String

Dim x As Long

For i = 2 To UBound(arr, 1)

If (i Mod 5000 = 0) Then

ws4.Cells(ws4.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 3).Value = Array(Now, "loop", "i=" & i)

End If

tmp = Trim(CStr(arr(i, colCode)))

tmp2 = Trim(CStr(arr(i, colName)))

' --- いきなり除外条件（根拠不明） ---

If tmp = "" And tmp2 = "" Then GoTo NX

dt = arr(i, colDate)

qty = Nz(arr(i, colQty))

price = Nz(arr(i, colPrice))

dept = Trim(CStr(arr(i, colDept)))

flag = Trim(CStr(arr(i, colFlag)))

' --- 日付の扱いが雑 ---

If IsDate(dt) Then

dt = CDate(dt)

ElseIf Len(CStr(dt)) = 8 And IsNumeric(dt) Then

dt = DateSerial(Left(CStr(dt), 4), Mid(CStr(dt), 5, 2), Right(CStr(dt), 2))

Else

' 謎の既定値

dt = Date

End If

' --- フラグで処理が変わる（仕様不明） ---

If flag = "X" Or flag = "除外" Or flag = "0" Then GoTo NX

' --- 部署補正：固定の置換がベタ書き ---

If dept = "総務部" Then dept = "G"

If dept = "営業部" Then dept = "S"

If dept = "製造部" Then dept = "M"

If dept = "" Then dept = "?"

' --- マスター参照（キー仕様が謎） ---

rate = 1

tax = 0.1

aliasName = ""

grp = ""

If dict2.Exists(tmp) Then

rate = dict2(tmp)(0)

tax = dict2(tmp)(1)

aliasName = dict2(tmp)(2)

grp = dict2(tmp)(3)

ElseIf dict2.Exists(tmp & "-A") Then

rate = dict2(tmp & "-A")(0)

tax = dict2(tmp & "-A")(1)

aliasName = dict2(tmp & "-A")(2)

grp = dict2(tmp & "-A")(3)

Else

' 見つからないと謎の補正

If InStr(1, tmp2, "特価") > 0 Then rate = 0.95

If InStr(1, tmp2, "輸入") > 0 Then tax = 0.08

End If

' --- 名称補正のルールが謎 ---

If aliasName <> "" Then

tmp2 = aliasName

Else

If InStr(tmp2, "　") > 0 Then tmp2 = Replace(tmp2, "　", " ")

If InStr(tmp2, "（") > 0 Then tmp2 = Left(tmp2, InStr(tmp2, "（") - 1)

tmp2 = Trim(tmp2)

End If

' --- 数値の補正が雑：負数・空白・文字混在 ---

If qty = 0 And InStr(1, CStr(arr(i, colQty)), "返品") > 0 Then qty = -1

If price = 0 And InStr(1, tmp2, "無料") > 0 Then price = 0

amt = qty * price * Nz(rate)

If amt < 0 Then memo = "neg" Else memo = ""

' --- 辞書で重複統合（キーがまた謎） ---

hh = dept & "|" & tmp & "|" & Format(dt, "yyyymm") & "|" & CStr(IIf(grp = "", "NA", grp))

If dict.Exists(hh) Then

x = dict(hh)

ws3.Cells(x, 7).Value = Nz(ws3.Cells(x, 7).Value) + amt

ws3.Cells(x, 5).Value = Nz(ws3.Cells(x, 5).Value) + qty

If memo <> "" Then ws3.Cells(x, 14).Value = ws3.Cells(x, 14).Value & "," & memo

Else

dict.Add hh, outRow

ws3.Cells(outRow, 1).Value = outRow - 1

ws3.Cells(outRow, 2).Value = tmp

ws3.Cells(outRow, 3).Value = tmp2

ws3.Cells(outRow, 4).Value = dt

ws3.Cells(outRow, 5).Value = qty

ws3.Cells(outRow, 6).Value = price

ws3.Cells(outRow, 7).Value = amt

ws3.Cells(outRow, 8).Value = dept

ws3.Cells(outRow, 9).Value = flag

ws3.Cells(outRow, 10).Value = rate

ws3.Cells(outRow, 11).Value = tax

ws3.Cells(outRow, 12).Value = aliasName

ws3.Cells(outRow, 13).Value = grp

ws3.Cells(outRow, 14).Value = memo

ws3.Cells(outRow, 15).Value = hh

outRow = outRow + 1

End If

NX:

Next i

' --- 仕上げ：並び替え・集計…と思いきやハードコードだらけ ---

With ws3.Sort

.SortFields.Clear

.SortFields.Add Key:=ws3.Range("H2:H" & outRow - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.SortFields.Add Key:=ws3.Range("B2:B" & outRow - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.SetRange ws3.Range("A1:O" & outRow - 1)

.Header = xlYes

.Apply

End With

' --- ここで突然、どこかのシートに転記（なぜ？） ---

If SheetExists("Report") Then

ThisWorkbook.Sheets("Report").Range("A1").CurrentRegion.Clear

ws3.Range("A1").CurrentRegion.Copy ThisWorkbook.Sheets("Report").Range("A1")

End If

FIN:

ed = Timer

ws4.Cells(ws4.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 5).Value = Array(Now, "end", "t=" & Format(ed - st, "0.00"), lastRow, outRow - 1)

Application.ScreenUpdating = True

Application.EnableEvents = True

Application.DisplayAlerts = True

Application.Calculation = xlCalculationAutomatic

End Sub

Private Function FindCol(ByVal ws As Worksheet, ByVal headers As Variant) As Long

On Error Resume Next

Dim c As Long, i As Long, t As String

For c = 1 To ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

t = Trim(UCase(CStr(ws.Cells(1, c).Value)))

If t <> "" Then

For i = LBound(headers) To UBound(headers)

If t = Trim(UCase(CStr(headers(i)))) Then

FindCol = c

Exit Function

End If

Next i

End If

Next c

End Function

Private Function Nz(ByVal v As Variant) As Double

On Error Resume Next

If IsError(v) Then Nz = 0: Exit Function

If IsMissing(v) Then Nz = 0: Exit Function

If v = "" Or v Is Nothing Then Nz = 0: Exit Function

If IsNumeric(v) Then Nz = CDbl(v) Else Nz = 0

End Function

Private Function SheetExists(ByVal nm As String) As Boolean

On Error Resume Next

SheetExists = Not ThisWorkbook.Sheets(nm) Is Nothing

End Function

【生成したテキスト】

以下、「Excel VBAの保守専門エンジニア」視点で、いただいたマクロを“保守できる形”にほどいて解説します。
（※原コードは意図的に雑に書かれているように見える箇所が多く、仕様が暗黙・例外握りつぶし・ハードコードが混在しています。）

① 機能概要

このマクロ（Sub __x1()）は、概ね次の処理をしています。

Rawシートの明細データを読み込む。
Masterシートを辞書化して、コードに紐づく「レート・税・別名・分類」を参照できるようにする。
Rawの各行を走査し、

日付や部署の表記揺れを補正し、
マスター参照で係数（rate）や税率（tax）などを付与し、
金額（数量×単価×レート）を計算する。

さらに、特定キーで重複を統合（集約）して、Workシートに集計結果を出す。
Workをソートする。
Reportシートがあれば、Workの結果をReportへコピーする。
Logシートに進捗と所要時間を記録する。

つまり、Raw明細 → マスター付与 → 部署×コード×年月×分類で集計 → 出力（Work/Report）のETL（加工・集計）系マクロです。

② 処理フロー（番号付き）

エラーを握りつぶす設定（On Error Resume Next）を有効化する。
速度優先設定をON。

画面更新OFF、イベントOFF、警告OFF、計算手動。

対象シートを取得。

Raw / Master / Work

Logシートの存在チェック。

無ければ新規作成し、ヘッダ（ts/step/msg/x/y）を作る。

Logに「start」を追記。
Workシートを全消去（ws3.Cells.Clear）。
Rawの最終行・最終列を取得。
Rawにデータが無ければ終了へ（lastRow < 2）。
Rawのヘッダ行から、必要列（コード/名称/日付/数量/単価/部署/フラグ）を推定。
見つからない列は勝手に決め打ち（1～7列）する。
Raw範囲を配列へ読み込み（高速化）。
Dictionaryを2つ作成。

dict：Work出力の集約キー→出力行番号
dict2：Masterのコード→（Rate,Tax,Alias,Group）

Masterのヘッダから必要列（コード/レート/税/別名/分類）を推定。
見つからない列は勝手に決め打ち（1～5列）する。
Masterを2行目から読み、dict2に格納（同一キーは最初のみ採用）。
Workに出力ヘッダ（A～O）を書き込む。
Raw配列を2行目からループ。
5000行ごとにLogへ進捗を書き込む。
コード・名称が両方空なら除外。
日付・数量・単価・部署・フラグを取得。
日付を雑に補正。

日付型ならCDate
8桁数値ならyyyymmddとみなしてDateSerial
それ以外は「今日」にする

フラグが X / 除外 / 0 なら除外。
部署名を固定置換（総務→G、営業→S、製造→M、空→?）。
Master参照（コード or コード-A）で、rate/tax/alias/group を付与。

見つからない場合は、名称に「特価」「輸入」が含まれる等で補正。

名称補正。

aliasがあればそれを採用
無ければ全角スペース→半角、括弧以降を削除、Trim

数量・単価の雑補正。

qty=0 かつ元文字に「返品」なら qty=-1
price=0 かつ名称に「無料」なら price=0（実質変化なし）

金額 amt = qty * price * rate

amt<0なら memo="neg"

集約キー hh を作成。

dept|code|yyyymm|group(or NA)

既存キーならWork該当行に加算（数量/金額）し、memoを追記。
新規キーならWorkに新行出力。
Workを部署→コードでソート。
Reportシートがあれば、Reportの現領域を消してWorkをコピー。
Logに「end」および処理時間/行数を記録。
Excel設定を元に戻して終了。

③ 入出力一覧表

④ 問題点・リスク

A. 致命的：エラー握りつぶし（保守不能化）

On Error Resume Next がサブルーチン冒頭から最後まで有効。
どこで失敗しても黙って進むので、間違った集計結果が“正常終了”する可能性が高い。

B. 破壊的操作（削除/上書き）

ws3.Cells.Clear で Work 全消去。
Report存在時に CurrentRegion.Clear で Reportの表を全消去。
誤シート参照やヘッダ推定ミスがあると、必要データを消す事故が起きやすい。

C. ヘッダ推定が不安定＋見つからないと決め打ち

FindColが見つからないと 1～7列を勝手に割当。
これにより、列構成が少し変わっただけで 別列を読んで計算してしまう。
誤集計の温床。

D. 日付の既定値が「今日」

日付が読めない場合に dt = Date。
つまりデータ不備があると、当月の集計に紛れ込む。
後から発見が難しい最悪パターン。

E. 仕様がコードにベタ書き（部署補正、除外条件、名称補正）

部署変換が固定（総務→G等）。
フラグ除外が固定（X/除外/0）。
名称から括弧を削除などのルールが固定。
変更要求が来たときに改修が難しい。

F. 税（tax）を付与しているが計算に未使用

WorkヘッダにTax列があるのに、金額計算に反映していない。
将来「税込/税抜」を混同するリスク。

G. 辞書キー仕様が不明瞭

集約キー：dept|code|yyyymm|group
これが本当に正しい粒度か仕様不明。
たとえば「日別で必要」など要件が変わると破綻。

H. 型が全部Variantで曖昧

Dim a, b, c... ほぼ未使用。
dt/qty/price/rate がVariantで混在。
暗黙変換で事故が起こりやすい。

⑤ 改善提案

1) 例外処理を“握りつぶし→記録して止める”へ

冒頭の On Error Resume Next を廃止。
代わりに On Error GoTo EH を使い、Logに詳細を書いて安全に復旧。

2) 破壊操作の前に安全策

Work/ReportのClear前に、

対象範囲を限定（UsedRangeのみ等）
バックアップ（別シート/CSV出力）
実行前チェック（Raw件数、必須列の存在）
を入れる。

3) ヘッダ推定で「見つからなければ中断」

見つからない場合に決め打ちしない。
必須列が不足なら、どの列が足りないかを明示して終了。

4) “仕様値”を定数/設定シートに退避

部署変換、除外フラグ、名称整形ルール、Masterのキー補助（“-A”）などを
コード直書きではなく設定テーブルへ。

5) データ処理は配列で完結、最後に一括出力

現状は「集約時にセルを都度更新」していて遅くなる可能性。
集約結果もDictionaryに溜めて、最後に配列→Rangeへ一括出力すると速い＆安全。

6) 税の扱いを仕様化

Amountが税抜なのか税込なのか。
税を使うなら amt = qty * price * rate * (1 + tax) など仕様確定が必要。
仕様不明のため、改善版では「税は列に出すが金額には掛けない（現状互換）」を維持し、コメントで注意喚起します。

⑥ 改善後のVBAコード（フルコード）

原コードの“出力結果の互換”を優先し、ロジックは極力維持。
ただし
(1)必須列不足は中断、(2)例外はログして終了、(3)クリア範囲をUsedRange中心、(4)型と関数を整理、(5)定数化 を行いました。
Workへの加算更新は互換のため維持（ただし必要箇所のみ）。
ログは必ず残るようにしています。

Option Explicit

'========================

' メイン

'========================

Public Sub BuildWorkFromRaw()

Dim st As Double: st = Timer

Dim wsRaw As Worksheet, wsMst As Worksheet, wsWork As Worksheet, wsLog As Worksheet

Dim wsRep As Worksheet

On Error GoTo EH

'--- Excel高速化（必ずFinallyで戻す）

Dim prevCalc As XlCalculation

prevCalc = Application.Calculation

Application.ScreenUpdating = False

Application.EnableEvents = False

Application.DisplayAlerts = False

Application.Calculation = xlCalculationManual

Set wsRaw = ThisWorkbook.Worksheets("Raw")

Set wsMst = ThisWorkbook.Worksheets("Master")

Set wsWork = ThisWorkbook.Worksheets("Work")

Set wsLog = EnsureLogSheet(ThisWorkbook, wsWork)

LogWrite wsLog, "start", "go", "", ""

'--- Work初期化（危険操作なので範囲をUsedRange中心に）

ClearSheetSafely wsWork

wsWork.Range("A1").Value = "tmp" '原コード互換：意味は不明だが残す

'--- Raw最終行列

Dim lastRow As Long, lastCol As Long

lastRow = wsRaw.Cells(wsRaw.Rows.Count, 1).End(xlUp).Row

lastCol = wsRaw.Cells(1, wsRaw.Columns.Count).End(xlToLeft).Column

If lastRow < 2 Or lastCol < 1 Then GoTo FINALLY 'データ無し

'--- Rawヘッダ列の特定（必須列が無ければ中断）

Dim colCode As Long, colName As Long, colDate As Long, colQty As Long, colPrice As Long, colDept As Long, colFlag As Long

colCode = FindColStrict(wsRaw, Array("コード", "品目コード", "ITEM", "ItemCode", "商品CD"))

colName = FindColStrict(wsRaw, Array("名称", "品目名", "ITEMNAME", "ItemName"))

colDate = FindColStrict(wsRaw, Array("日付", "取引日", "DATE", "Date"))

colQty = FindColStrict(wsRaw, Array("数量", "QTY", "Qty", "個数"))

colPrice = FindColStrict(wsRaw, Array("単価", "価格", "PRICE", "Price"))

colDept = FindColStrict(wsRaw, Array("部署", "部門", "DEPT", "Department"))

colFlag = FindColStrict(wsRaw, Array("フラグ", "FLAG", "状態", "Status"))

Dim missing As String

missing = MissingColsMessage(colCode, colName, colDate, colQty, colPrice, colDept, colFlag)

If Len(missing) > 0 Then

LogWrite wsLog, "error", "missing headers: " & missing, lastRow, lastCol

Err.Raise vbObjectError + 1000, "BuildWorkFromRaw", "必須ヘッダが見つかりません: " & missing

End If

'--- Rawを配列へ

Dim arr As Variant

arr = wsRaw.Range(wsRaw.Cells(1, 1), wsRaw.Cells(lastRow, lastCol)).Value

'--- Master辞書化

Dim dictMst As Object

Set dictMst = CreateObject("Scripting.Dictionary")

BuildMasterDictionary wsMst, dictMst, wsLog

'--- 集計用辞書（集約キー→Work行番号）

Dim dictOut As Object

Set dictOut = CreateObject("Scripting.Dictionary")

'--- Workヘッダ

wsWork.Range("A1:O1").Value = Array("K", "Code", "Name", "Date", "Qty", "Price", "Amount", "Dept", "Flag", "Rate", "Tax", "AdjName", "Group", "Memo", "Hash")

Dim outRow As Long: outRow = 2

'--- ループ処理

Dim i As Long

For i = 2 To UBound(arr, 1)

If (i Mod 5000 = 0) Then LogWrite wsLog, "loop", "i=" & i, "", ""

Dim code As String, name As String

code = Trim$(CStr(arr(i, colCode)))

name = Trim$(CStr(arr(i, colName)))

'除外：コードも名称も空

If code = "" And name = "" Then GoTo NEXT_I

'取得

Dim dt As Date

dt = NormalizeDate(arr(i, colDate)) '読めない場合は「今日」ではなく、ここで例外 or 既定値を選べる

Dim qty As Double, price As Double

qty = NzD(arr(i, colQty))

price = NzD(arr(i, colPrice))

Dim dept As String, flag As String

dept = Trim$(CStr(arr(i, colDept)))

flag = Trim$(CStr(arr(i, colFlag)))

'フラグ除外（原コード互換）

If flag = "X" Or flag = "除外" Or flag = "0" Then GoTo NEXT_I

'部署補正（原コード互換）

dept = NormalizeDept(dept)

'Master参照（原コード互換：code / code-A）

Dim rate As Double, tax As Double

Dim aliasName As String, grp As String

rate = 1#

tax = 0.1

aliasName = vbNullString

grp = vbNullString

ApplyMaster dictMst, code, name, rate, tax, aliasName, grp

'名称補正（原コード互換）

Dim adjName As String

adjName = NormalizeName(name, aliasName)

'数量/単価の補正（原コード互換）

If qty = 0 And InStr(1, CStr(arr(i, colQty)), "返品", vbTextCompare) > 0 Then qty = -1

If price = 0 And InStr(1, adjName, "無料", vbTextCompare) > 0 Then price = 0 '意味は薄いが互換維持

'金額（税は掛けない：原コード互換）

Dim amt As Double

amt = qty * price * rate

Dim memo As String

If amt < 0 Then memo = "neg" Else memo = vbNullString

'集約キー：部署|コード|yyyymm|分類（なければNA）

Dim hh As String

hh = dept & "|" & code & "|" & Format$(dt, "yyyymm") & "|" & IIf(grp = "", "NA", grp)

If dictOut.Exists(hh) Then

Dim r As Long

r = CLng(dictOut(hh))

wsWork.Cells(r, 7).Value = NzD(wsWork.Cells(r, 7).Value) + amt

wsWork.Cells(r, 5).Value = NzD(wsWork.Cells(r, 5).Value) + qty

If memo <> "" Then

If Len(wsWork.Cells(r, 14).Value) = 0 Then

wsWork.Cells(r, 14).Value = memo

Else

wsWork.Cells(r, 14).Value = wsWork.Cells(r, 14).Value & "," & memo

End If

Else

dictOut.Add hh, outRow

wsWork.Cells(outRow, 1).Value = outRow - 1

wsWork.Cells(outRow, 2).Value = code

wsWork.Cells(outRow, 3).Value = adjName

wsWork.Cells(outRow, 4).Value = dt

wsWork.Cells(outRow, 5).Value = qty

wsWork.Cells(outRow, 6).Value = price

wsWork.Cells(outRow, 7).Value = amt

wsWork.Cells(outRow, 8).Value = dept

wsWork.Cells(outRow, 9).Value = flag

wsWork.Cells(outRow, 10).Value = rate

wsWork.Cells(outRow, 11).Value = tax

wsWork.Cells(outRow, 12).Value = aliasName

wsWork.Cells(outRow, 13).Value = grp

wsWork.Cells(outRow, 14).Value = memo

wsWork.Cells(outRow, 15).Value = hh

outRow = outRow + 1

End If

NEXT_I:

Next i

'--- ソート（原コード互換：Dept→Code）

If outRow > 2 Then

With wsWork.Sort

.SortFields.Clear

.SortFields.Add Key:=wsWork.Range("H2:H" & outRow - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.SortFields.Add Key:=wsWork.Range("B2:B" & outRow - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.SetRange wsWork.Range("A1:O" & outRow - 1)

.Header = xlYes

.Apply

End With

End If

'--- Report転記（危険：消すので存在時のみ、かつ範囲限定）

If SheetExists(ThisWorkbook, "Report") Then

Set wsRep = ThisWorkbook.Worksheets("Report")

wsRep.UsedRange.Clear

wsWork.Range("A1").CurrentRegion.Copy wsRep.Range("A1")

End If

FINALLY:

Dim ed As Double: ed = Timer

LogWrite wsLog, "end", "t=" & Format$(ed - st, "0.00"), lastRow, outRow - 1

Application.ScreenUpdating = True

Application.EnableEvents = True

Application.DisplayAlerts = True

Application.Calculation = prevCalc

Exit Sub

EH:

'致命エラーはログして復旧

On Error Resume Next

If Not wsLog Is Nothing Then

LogWrite wsLog, "fatal", Err.Number & ":" & Err.Description, "", ""

End If

Application.ScreenUpdating = True

Application.EnableEvents = True

Application.DisplayAlerts = True

Application.Calculation = prevCalc

Err.Raise Err.Number, Err.Source, Err.Description

End Sub

'========================

' Master辞書化

'========================

Private Sub BuildMasterDictionary(ByVal wsMst As Worksheet, ByVal dictMst As Object, ByVal wsLog As Worksheet)

Dim mLast As Long

mLast = wsMst.Cells(wsMst.Rows.Count, 1).End(xlUp).Row

If mLast < 2 Then Exit Sub

Dim mcCode As Long, mcRate As Long, mcTax As Long, mcAlias As Long, mcGrp As Long

mcCode = FindColStrict(wsMst, Array("コード", "品目コード", "ITEM", "ItemCode"))

mcRate = FindColStrict(wsMst, Array("レート", "Rate", "係数"))

mcTax = FindColStrict(wsMst, Array("税", "Tax", "TAX"))

mcAlias = FindColStrict(wsMst, Array("別名", "Alias", "名称補正"))

mcGrp = FindColStrict(wsMst, Array("分類", "Group", "カテゴリ"))

'Masterは列不足でも動かしたいケースがあり得るが、現状は“仕様不明”なのでログだけ残す

If mcCode = 0 Then LogWrite wsLog, "warn", "Master: code header not found", "", ""

If mcRate = 0 Then LogWrite wsLog, "warn", "Master: rate header not found", "", ""

If mcTax = 0 Then LogWrite wsLog, "warn", "Master: tax header not found", "", ""

If mcAlias = 0 Then LogWrite wsLog, "warn", "Master: alias header not found", "", ""

If mcGrp = 0 Then LogWrite wsLog, "warn", "Master: group header not found", "", ""

'互換：見つからない場合の決め打ちは最小限に残す（ただし極力推奨しない）

If mcCode = 0 Then mcCode = 1

If mcRate = 0 Then mcRate = 2

If mcTax = 0 Then mcTax = 3

If mcAlias = 0 Then mcAlias = 4

If mcGrp = 0 Then mcGrp = 5

Dim i As Long, key As String

For i = 2 To mLast

key = Trim$(CStr(wsMst.Cells(i, mcCode).Value))

If key <> "" Then

If Not dictMst.Exists(key) Then

dictMst.Add key, Array( _

NzD(wsMst.Cells(i, mcRate).Value), _

NzD(wsMst.Cells(i, mcTax).Value), _

CStr(wsMst.Cells(i, mcAlias).Value), _

CStr(wsMst.Cells(i, mcGrp).Value) _

)

End If

Next i

End Sub

Private Sub ApplyMaster(ByVal dictMst As Object, ByVal code As String, ByVal name As String, _

ByRef rate As Double, ByRef tax As Double, ByRef aliasName As String, ByRef grp As String)

If dictMst.Exists(code) Then

rate = NzD(dictMst(code)(0))

tax = NzD(dictMst(code)(1))

aliasName = CStr(dictMst(code)(2))

grp = CStr(dictMst(code)(3))

ElseIf dictMst.Exists(code & "-A") Then

rate = NzD(dictMst(code & "-A")(0))

tax = NzD(dictMst(code & "-A")(1))

aliasName = CStr(dictMst(code & "-A")(2))

grp = CStr(dictMst(code & "-A")(3))

Else

'互換：見つからない場合の補正（根拠不明だが既存仕様として残す）

If InStr(1, name, "特価", vbTextCompare) > 0 Then rate = 0.95

If InStr(1, name, "輸入", vbTextCompare) > 0 Then tax = 0.08

End If

'rateが0や空で事故るのを予防

If rate = 0 Then rate = 1#

End Sub

'========================

' 正規化系

'========================

Private Function NormalizeDept(ByVal dept As String) As String

dept = Trim$(dept)

Select Case dept

Case "総務部": NormalizeDept = "G"

Case "営業部": NormalizeDept = "S"

Case "製造部": NormalizeDept = "M"

Case "": NormalizeDept = "?"

Case Else: NormalizeDept = dept

End Select

End Function

Private Function NormalizeName(ByVal rawName As String, ByVal aliasName As String) As String

Dim s As String

If Len(Trim$(aliasName)) > 0 Then

NormalizeName = Trim$(aliasName)

Exit Function

End If

s = CStr(rawName)

s = Replace(s, "　", " ") '全角スペース→半角

'（があれば手前まで

Dim p As Long

p = InStr(1, s, "（", vbBinaryCompare)

If p > 0 Then s = Left$(s, p - 1)

NormalizeName = Trim$(s)

End Function

Private Function NormalizeDate(ByVal v As Variant) As Date

'原コードは「読めない→今日」にしていたが、監査的に危険。

'ただし互換性を維持するため、ここでは原コード同様「今日」を返す。

'本来は「Null扱いにして除外」「エラーで止める」などを推奨。

If IsDate(v) Then

NormalizeDate = CDate(v)

Exit Function

End If

Dim s As String

s = Trim$(CStr(v))

If Len(s) = 8 And IsNumeric(s) Then

NormalizeDate = DateSerial(CInt(Left$(s, 4)), CInt(Mid$(s, 5, 2)), CInt(Right$(s, 2)))

Exit Function

End If

NormalizeDate = Date '互換：原コード仕様

End Function

'========================

' 便利関数

'========================

Private Function FindColStrict(ByVal ws As Worksheet, ByVal headers As Variant) As Long

Dim c As Long, i As Long, t As String

Dim lastCol As Long

lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

For c = 1 To lastCol

t = Trim$(UCase$(CStr(ws.Cells(1, c).Value)))

If t <> "" Then

For i = LBound(headers) To UBound(headers)

If t = Trim$(UCase$(CStr(headers(i)))) Then

FindColStrict = c

Exit Function

End If

Next i

End If

Next c

FindColStrict = 0

End Function

Private Function NzD(ByVal v As Variant) As Double

If IsError(v) Then NzD = 0#: Exit Function

If IsEmpty(v) Then NzD = 0#: Exit Function

If VarType(v) = vbString Then

If Trim$(CStr(v)) = "" Then NzD = 0#: Exit Function

End If

If IsNumeric(v) Then NzD = CDbl(v) Else NzD = 0#

End Function

Private Function SheetExists(ByVal wb As Workbook, ByVal nm As String) As Boolean

On Error Resume Next

SheetExists = Not wb.Worksheets(nm) Is Nothing

End Function

Private Function EnsureLogSheet(ByVal wb As Workbook, ByVal afterSheet As Worksheet) As Worksheet

Dim ws As Worksheet

If SheetExists(wb, "Log") Then

Set EnsureLogSheet = wb.Worksheets("Log")

Else

Set ws = wb.Worksheets.Add(After:=afterSheet)

ws.Name = "Log"

ws.Range("A1:E1").Value = Array("ts", "step", "msg", "x", "y")

Set EnsureLogSheet = ws

End If

End Function

Private Sub LogWrite(ByVal wsLog As Worksheet, ByVal stepName As String, ByVal msg As String, ByVal x As Variant, ByVal y As Variant)

Dim r As Long

r = wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Row + 1

wsLog.Cells(r, 1).Value = Now

wsLog.Cells(r, 2).Value = stepName

wsLog.Cells(r, 3).Value = msg

wsLog.Cells(r, 4).Value = x

wsLog.Cells(r, 5).Value = y

End Sub

Private Sub ClearSheetSafely(ByVal ws As Worksheet)

'Cells.Clearは強い（書式/コメント/名前付き範囲の見え方にも影響しやすい）

'UsedRangeを基本に消す（それでも危険なので、運用ではバックアップ推奨）

If ws.UsedRange.Cells.Count > 1 Or Len(CStr(ws.Range("A1").Value)) > 0 Then

ws.UsedRange.Clear

Else

ws.Cells.Clear

End If

End Sub

Private Function MissingColsMessage( _

ByVal colCode As Long, ByVal colName As Long, ByVal colDate As Long, _

ByVal colQty As Long, ByVal colPrice As Long, ByVal colDept As Long, ByVal colFlag As Long) As String

Dim s As String

If colCode = 0 Then s = s & "コード, "

If colName = 0 Then s = s & "名称, "

If colDate = 0 Then s = s & "日付, "

If colQty = 0 Then s = s & "数量, "

If colPrice = 0 Then s = s & "単価, "

If colDept = 0 Then s = s & "部署, "

If colFlag = 0 Then s = s & "フラグ, "

If Len(s) > 0 Then s = Left$(s, Len(s) - 2)

MissingColsMessage = s

End Function

必要なら、次の“保守のための追加成果物”もすぐ作れます（質問は不要です、こちらで仮置きして提示できます）。

「仕様書（推定）」：集約キーの意味、除外条件、補正ルールを仕様として文章化。
「テスト観点表」：Rawの列ずれ、日付異常、マスタ未登録、返品、負数、空欄、Report有無などの網羅。

「設定シート化案」：部署変換・除外フラグ・マスタキー派生（-A）などをExcel表で管理。

（※）生成AIは、場合によって事実と異なる内容を含む可能性があります。本ブログで掲載している生成AIの出力結果は、あくまでも傾向の把握や参考情報としてご利用いただけますと幸いです。

期待効果

このプロンプトを使うと、現場で何が変わるのか。
効果を“実務の時間”に変換して語ります。

効果1。読む順番が整うので、理解が加速する。
VBA保守が辛い理由は、読む順番がバラバラだからです。
いきなりCells.Clear。
いきなり辞書。
いきなりGoTo。
いきなり転記。
こういうコードを、頭の中だけで追うのは無理ゲーです。

でも、ChatGPTが「機能概要→フロー→入出力→リスク」の順で整理してくれると、読む側の認知負荷が激減します。
結果として、仕様確認の打ち合わせが短くなります。
関係者の理解が揃いやすくなります。

効果2。副作用と危険が先に見えるので、事故が減る。
Workを全消去する。
Reportを消す。
警告を消す。
こういう危険を先に列挙できると、運用が変わります。
実行前バックアップを取る。
テスト用ブックで試す。
権限を制限する。
保護シートを入れる。
こうした“守りの仕組み”が作れます。

現場が欲しいのは、完璧なコードよりも「事故らない安心感」です。
このプロンプトは、その安心感を作る材料を出してくれます。

効果3。保守の議論が「感想」から「論点」に変わる。
ブラックボックスの会議は、だいたいこうなります。
「怖い。
触りたくない。
でも直して。」
これだと前に進みません。

ChatGPTの出力があると、会話が変わります。
どのシートが入力か。
どこが削除か。
集約キーは何か。
除外条件は何か。
日付の既定値は何か。
この論点で話せます。

つまり、仕様の会話ができるようになります。
これが最大の価値です。

効果4。改善版コードが“最初の一歩”になる。
多くの現場は、最初の一歩が踏み出せません。
でも改善版コードがあると、次の動きができます。
差分比較ができる。
テスト観点が作れる。
レビューができる。
段階的に置き換えられる。

保守は、完璧に直すより“段階的に安全にする”ことが多いです。
そのためのスタート地点を、ChatGPTが作ってくれます。