Excelで転記を半自動化するVBAマクロ｜数量・単位の差異も自動チェック【実例付き】

どうも、くまおやぢです。

Excelで下請業者さんの見積を比較するのに、こんな経験はありませんか？

• 各社の回答書を転記するのが、とにかく面倒
• 親番・枝番を目で追いながら手作業でコピペしている
• 数量や単位が微妙に違っていて、途中で混乱する
• 後から「ここ、どこが違ってたんだっけ？」と分からなくなる

特に建設系の仕事をしている方なら、この苦しみは身に染みているはずです。

正直に言います。 わたし自身、現場管理の仕事をしていた頃は「転記ミス」「見落とし」「数量差異の見逃し」に何度も苦しめられました。

多い時は100を超えてくる項目の見積を、目を皿にして突き合わせする。 夕方になって集中力が切れたころに限って、致命的な転記ミスが潜んでいる。 建設業の利益率は数パーセントの世界ですから、たったひとつの数量見落としで簡単に赤字になることだってあります。

そこで作ったのが、今回ご紹介する転記の半自動マクロ（v4 縦横検索版）です。

ですが、大事なことを先にお伝えしておきます。

この記事で紹介するのは完全自動化ではありません。半自動化です。

なぜか？ それは、見積比較という仕事の本質が「差異を見ること」そのものだからです。

---

急いでいる人へ｜この記事の結論

このマクロでできることは、次の6つです。

1. 親番＋枝番で自動突合 → 項目番号の照合を自動化
2. 数量・単位・単価・金額・備考を自動転記 → 手作業コピペから解放
3. 名称・規格の差異を検出 → 社名変更や工法の読み替えも見逃さない
4. 数量差異を検出 → 予定数量と回答数量を自動比較
5. 単位差異を検出 → 「m3」と「ヶ所」の違いも見逃さない
6. 差異列を自動挿入して記録 → 差異がある行だけ、具体的な内容を自動記録

つまり、こういう役割分担です。

役割	担当
検索・転記・差異フラグ	Excel（マクロ）
差異の原因分析・最終判断	あなた（人間）

転記はExcelに任せて、判断に集中する。 これが、今回のマクロの基本思想です。

VBAコードはこの記事の中盤に掲載しています。コピペでそのまま使えますので、まずは試してみてください。

---

なぜ完全自動化ではなく「半自動」なのか

見積比較では、数量や単位が違うことは珍しくありません。 たとえば、こんなケースです。

項目	予定	A社回答
数量	20	1
単位	m3	ヶ所

この違いは、必ずしもミスではありません。

原因はさまざまです。

• 図面の読み取り精度の違い
• 採用する施工方法（工法）の違い
• 数量拾いの考え方の違い（端数処理・「一式」に含める範囲など）
• リスクの織り込み方の違い（安全率・材料高騰の見込みなど）

つまり、差異＝ミスとは限らないということ。

ここを機械的に「揃えて」しまったら、技術的な議論の芽を摘んでしまいます。

だから、自動化の目的はこうなります。

• ✕ 差異を消すこと
• ◎ 差異を「見える化」すること

この思想で今回のマクロを設計しています。

次の章では、実際のExcelファイルを使ってレイアウトを確認していきます。

---

実例で確認｜比較表と回答書のレイアウト

まず、実際のExcelファイルを見ながらレイアウトを確認しましょう。

転記表（比較表）のシート構成

転記表は、以下の列構成で作成します。

列	見出し	役割
A	No	連番
B	No1（親番）	突合キー①
C	No2（枝番）	突合キー②
D	名称	工種・品目
E	規格	仕様・寸法
F	予定数量	発注者側の設計数量
G	予定単位	発注者側の単位
H〜	各社ブロック	1社5列で繰り返す

各社のブロックは、次の5列で1セットです。

列の役割	A社	B社	C社
数量	H列	M列	R列
単位	I列	N列	S列
単価	J列	O列	T列
金額	K列	P列	U列
備考	L列	Q列	V列

見出し行（1行目）には必ず 「数量」「単位」「単価」「金額」「備考」 という文字列を入れてください。 v4マクロは、列番号ではなく見出し文字列を読んで列を自動検出します。 列を後から追加・変更しても、見出しさえ合っていればコードを書き直す必要はありません。

回答書のシート構成

各社から受け取った回答書は、次の列構成を想定しています。

見出し	説明
親番	転記表のNo1（B列）と突合するキー
枝番	転記表のNo2（C列）と突合するキー
名称	工種・品目名
規格	仕様・寸法
数量	業者が回答した数量
単位	業者が回答した単位
単価	業者が回答した単価
金額	業者が回答した金額
備考	業者のコメント

回答書の見出し行も、マクロが自動で読み取ります。 「親番」「枝番」「数量」の3つが見出し行に存在していれば、他の列は存在しなくても動作します。

次の章で、いよいよVBAコードをご紹介していきます。

---

VBAコード（コピペ可）｜縦横検索版 v4 完成版

以下のコードをExcelのVBAエディタで「標準モジュール」に貼り付けてください。

動作確認環境　Windows / Excel 2019 / Microsoft 365 保存形式　.xlsm（マクロ有効ブック） で保存してください

Sub 回答を会社ブロックへ転記_縦横検索版()
'==========================================================
' 比較表転記マクロ（縦横検索版 v4）
'
' 【縦】No1(親番) + No2(枝番) で行を突合
' 【横】列見出し文字列で列番号を動的に検索して転記
'
' 【差異の扱い】
'   ・転記先に差異列はない（デフォルト）
'   ・差異が生じた行が最初に現れた時点で備考の右隣に列を挿入
'   ・差異なしの行は空白のまま
'   ・表記例
'       名称（予定：掘削A　→回答：掘削B）
'       規格（予定：　　　 →回答：人力含む）
'       数量（予定：50　　 →回答：40）
'       単位（予定：m3　　 →回答：ヶ所）
'
' 【使い方】
'   手順1：回答書の「親番」先頭データセルを1クリック
'   手順2：転記表の転記先ブロック「数量」先頭セルを1クリック
'==========================================================

    '--- ★ 見出し文字列（シートに合わせて変更可） ---

    ' 回答書の列見出し
    Const S_NO1   As String = "親番"
    Const S_NO2   As String = "枝番"
    Const S_NAME  As String = "名称"
    Const S_SPEC  As String = "規格"
    Const S_QTY   As String = "数量"
    Const S_UNIT  As String = "単位"
    Const S_PRICE As String = "単価"
    Const S_AMT   As String = "金額"
    Const S_MEMO  As String = "備考"

    ' 転記表の列見出し
    Const D_NO1   As String = "No1"
    Const D_NO2   As String = "No2"
    Const D_NAME  As String = "名称"
    Const D_SPEC  As String = "規格"
    Const D_YQTY  As String = "予定数量"   '予定単位はその直右を自動参照
    Const D_QTY   As String = "数量"
    Const D_UNIT  As String = "単位"
    Const D_PRICE As String = "単価"
    Const D_AMT   As String = "金額"
    Const D_MEMO  As String = "備考"
    Const D_DIFF  As String = "差異"       '挿入する列の見出し名

    Dim srcAnchor As Range
    Dim dstAnchor As Range

    '=== 手順1：回答書の親番先頭セルを1クリック ===
    MsgBox "【手順1/2】回答書の「親番」列の" & vbCrLf & _
           "先頭データセルを1クリックしてください。" & vbCrLf & vbCrLf & _
           "（最終行・各列の位置は見出しから自動検出します）", _
           vbInformation, "転記マクロ"

    On Error Resume Next
    Set srcAnchor = Application.InputBox( _
        Prompt:="回答書の「親番」先頭セルをクリック", _
        Title:="回答書の指定", Type:=8)
    On Error GoTo 0
    If srcAnchor Is Nothing Then
        MsgBox "キャンセルされました。", vbExclamation: Exit Sub
    End If

    '=== 手順2：転記表の数量先頭セルを1クリック ===
    MsgBox "【手順2/2】転記表で転記先ブロックの" & vbCrLf & _
           "「数量」先頭セルを1クリックしてください。" & vbCrLf & vbCrLf & _
           "（そのセルを起点に見出し行を自動検出します）", _
           vbInformation, "転記マクロ"

    On Error Resume Next
    Set dstAnchor = Application.InputBox( _
        Prompt:="転記表の転記先ブロック「数量」先頭セルをクリック", _
        Title:="転記表の指定", Type:=8)
    On Error GoTo 0
    If dstAnchor Is Nothing Then
        MsgBox "キャンセルされました。", vbExclamation: Exit Sub
    End If

    Dim wsS As Worksheet: Set wsS = srcAnchor.Worksheet
    Dim wsD As Worksheet: Set wsD = dstAnchor.Worksheet

    '============================================================
    ' 回答書：見出し行から列番号マップを構築
    '============================================================
    Dim srcHeaderRow As Long: srcHeaderRow = srcAnchor.Row - 1
    If srcHeaderRow < 1 Then
        MsgBox "回答書の見出し行が見つかりません。" & vbCrLf & _
               "先頭データセルの1行上に見出し行が必要です。", vbCritical
        Exit Sub
    End If

    Dim sColNo1   As Long, sColNo2  As Long
    Dim sColName  As Long, sColSpec As Long
    Dim sColQty   As Long, sColUnit As Long
    Dim sColPrice As Long, sColAmt  As Long, sColMemo As Long
    Dim c As Long, sv As String

    For c = 1 To 50
        sv = CStr(wsS.Cells(srcHeaderRow, c).Value)
        Select Case sv
            Case S_NO1:   sColNo1 = c
            Case S_NO2:   sColNo2 = c
            Case S_NAME:  sColName = c
            Case S_SPEC:  sColSpec = c
            Case S_QTY:   If sColQty = 0 Then sColQty = c
            Case S_UNIT:  If sColUnit = 0 Then sColUnit = c
            Case S_PRICE: sColPrice = c
            Case S_AMT:   sColAmt = c
            Case S_MEMO:  sColMemo = c
        End Select
    Next c

    If sColNo1 = 0 Or sColNo2 = 0 Or sColQty = 0 Then
        MsgBox "回答書の見出し行に「" & S_NO1 & "」「" & S_NO2 & "」「" & S_QTY & "」が" & vbCrLf & _
               "見つかりませんでした。先頭セルを確認してください。", vbCritical
        Exit Sub
    End If

    Dim srcTopRow As Long: srcTopRow = srcAnchor.Row
    Dim srcEndRow As Long
    srcEndRow = wsS.Cells(wsS.Rows.Count, sColNo1).End(xlUp).Row

    '============================================================
    ' 転記表：クリックした数量セルの列を起点に見出し行を検索
    '============================================================
    Dim dstHeaderRow As Long: dstHeaderRow = 0
    Dim r As Long
    For r = dstAnchor.Row - 1 To 1 Step -1
        If CStr(wsD.Cells(r, dstAnchor.Column).Value) = D_QTY Then
            dstHeaderRow = r
            Exit For
        End If
    Next r

    If dstHeaderRow = 0 Then
        MsgBox "転記表の列見出し行が見つかりませんでした。" & vbCrLf & _
               "「" & D_QTY & "」の見出しが転記先セルの上方にあるか確認してください。", vbCritical
        Exit Sub
    End If

    ' クリックした列 = 数量列（確定）、そこから右へ順次検索
    Dim dstStartCol As Long: dstStartCol = dstAnchor.Column
    Dim dColQty   As Long: dColQty = dstStartCol
    Dim dColUnit  As Long, dColPrice As Long
    Dim dColAmt   As Long, dColMemo  As Long
    Dim dv As String

    For c = dstStartCol + 1 To dstStartCol + 20
        dv = CStr(wsD.Cells(dstHeaderRow, c).Value)
        Select Case dv
            Case D_UNIT:  If dColUnit = 0 Then dColUnit = c
            Case D_PRICE: If dColPrice = 0 Then dColPrice = c
            Case D_AMT:   If dColAmt = 0 Then dColAmt = c
            Case D_MEMO:  If dColMemo = 0 Then dColMemo = c
        End Select
        If c > dstStartCol + 1 And dv = D_QTY Then Exit For
    Next c

    ' 転記表のNo1/No2・名称・規格・予定数量を全体から検索
    Dim dColNo1  As Long, dColNo2  As Long
    Dim dColName As Long, dColSpec As Long
    Dim dColYQty As Long, dColYUnit As Long
    For c = 1 To 50
        Select Case CStr(wsD.Cells(dstHeaderRow, c).Value)
            Case D_NO1:  dColNo1 = c
            Case D_NO2:  dColNo2 = c
            Case D_NAME: dColName = c
            Case D_SPEC: dColSpec = c
            Case D_YQTY: dColYQty = c: dColYUnit = c + 1
        End Select
    Next c

    If dColNo1 = 0 Or dColNo2 = 0 Then
        MsgBox "転記表の見出し行に「" & D_NO1 & "」「" & D_NO2 & "」が見つかりませんでした。", vbCritical
        Exit Sub
    End If

    ' 差異列の挿入位置 = 備考の右隣（備考がなければブロック末尾の右隣）
    Dim diffInsertCol As Long
    If dColMemo > 0 Then
        diffInsertCol = dColMemo + 1
    Else
        Dim maxCol As Long: maxCol = dColQty
        If dColUnit  > maxCol Then maxCol = dColUnit
        If dColPrice > maxCol Then maxCol = dColPrice
        If dColAmt   > maxCol Then maxCol = dColAmt
        diffInsertCol = maxCol + 1
    End If

    ' 差異列はまだ存在しない（デフォルト）
    Dim dColDiff      As Long:    dColDiff = 0
    Dim diffColInserted As Boolean: diffColInserted = False

    ' 転記表のデータ走査範囲
    Dim dstTopRow As Long: dstTopRow = dstAnchor.Row
    Dim lastRowD  As Long
    lastRowD = wsD.Cells(wsD.Rows.Count, dColNo1).End(xlUp).Row

    '============================================================
    ' 転記実行
    '============================================================
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim rS As Long, rD As Long
    Dim cntHit  As Long: cntHit = 0
    Dim cntDiff As Long: cntDiff = 0
    Dim cntSkip As Long: cntSkip = 0

    Dim diffLines(10) As String
    Dim diffCount As Long
    Dim diffMsg   As String
    Dim i As Long

    For rD = dstTopRow To lastRowD

        If IsEmpty(wsD.Cells(rD, dColNo1).Value) Then GoTo NextDst

        Dim dNo1 As String: dNo1 = CStr(wsD.Cells(rD, dColNo1).Value)
        Dim dNo2 As String: dNo2 = CStr(wsD.Cells(rD, dColNo2).Value)
        Dim matched As Boolean: matched = False

        For rS = srcTopRow To srcEndRow

            If IsEmpty(wsS.Cells(rS, sColNo1).Value) Then GoTo NextSrc

            If dNo1 = CStr(wsS.Cells(rS, sColNo1).Value) And _
               dNo2 = CStr(wsS.Cells(rS, sColNo2).Value) Then

                '--- 転記 ---
                wsD.Cells(rD, dColQty).Value = wsS.Cells(rS, sColQty).Value
                If dColUnit  > 0 Then wsD.Cells(rD, dColUnit).Value  = wsS.Cells(rS, sColUnit).Value
                If dColPrice > 0 Then wsD.Cells(rD, dColPrice).Value = wsS.Cells(rS, sColPrice).Value
                If dColAmt   > 0 Then wsD.Cells(rD, dColAmt).Value   = wsS.Cells(rS, sColAmt).Value
                If dColMemo  > 0 And sColMemo > 0 Then
                    wsD.Cells(rD, dColMemo).Value = wsS.Cells(rS, sColMemo).Value
                End If

                '============================================
                ' 差異チェック：名称・規格・数量・単位
                ' 表記：項目名（予定：○　→回答：○）
                '============================================
                diffCount = 0

                ' ① 名称
                If dColName > 0 And sColName > 0 Then
                    Dim dName As String: dName = CStr(wsD.Cells(rD, dColName).Value)
                    Dim sName As String: sName = CStr(wsS.Cells(rS, sColName).Value)
                    If dName <> sName Then
                        diffLines(diffCount) = "名称（予定：" & dName & "　→回答：" & sName & "）"
                        diffCount = diffCount + 1
                    End If
                End If

                ' ② 規格
                If dColSpec > 0 And sColSpec > 0 Then
                    Dim dSpec As String: dSpec = CStr(wsD.Cells(rD, dColSpec).Value)
                    Dim sSpec As String: sSpec = CStr(wsS.Cells(rS, sColSpec).Value)
                    If dSpec <> sSpec Then
                        diffLines(diffCount) = "規格（予定：" & dSpec & "　→回答：" & sSpec & "）"
                        diffCount = diffCount + 1
                    End If
                End If

                ' ③ 数量（予定数量 vs 回答数量）
                If dColYQty > 0 Then
                    Dim yQty   As String: yQty   = CStr(wsD.Cells(rD, dColYQty).Value)
                    Dim ansQty As String: ansQty = CStr(wsS.Cells(rS, sColQty).Value)
                    If yQty <> ansQty Then
                        diffLines(diffCount) = "数量（予定：" & yQty & "　→回答：" & ansQty & "）"
                        diffCount = diffCount + 1
                    End If
                End If

                ' ④ 単位（予定単位 vs 回答単位）
                If dColYUnit > 0 And sColUnit > 0 Then
                    Dim yUnit   As String: yUnit   = CStr(wsD.Cells(rD, dColYUnit).Value)
                    Dim ansUnit As String: ansUnit = CStr(wsS.Cells(rS, sColUnit).Value)
                    If yUnit <> ansUnit Then
                        diffLines(diffCount) = "単位（予定：" & yUnit & "　→回答：" & ansUnit & "）"
                        diffCount = diffCount + 1
                    End If
                End If

                '--- 差異あり → 列挿入（初回のみ）して書き込み ---
                If diffCount > 0 Then

                    ' 差異列がまだ存在しない場合のみ列を挿入
                    If Not diffColInserted Then
                        wsD.Columns(diffInsertCol).Insert Shift:=xlToRight
                        ' 見出し行に「差異」と書く
                        wsD.Cells(dstHeaderRow, diffInsertCol).Value = D_DIFF
                        dColDiff = diffInsertCol
                        diffColInserted = True
                    End If

                    ' 差異メッセージを改行で結合して書き込み
                    diffMsg = ""
                    For i = 0 To diffCount - 1
                        If i > 0 Then diffMsg = diffMsg & vbLf
                        diffMsg = diffMsg & diffLines(i)
                    Next i
                    wsD.Cells(rD, dColDiff).Value = diffMsg
                    cntDiff = cntDiff + 1
                End If

                cntHit = cntHit + 1
                matched = True
                Exit For
            End If

NextSrc:
        Next rS

        If Not matched Then cntSkip = cntSkip + 1

NextDst:
    Next rD

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    '--- 完了レポート ---
    Dim colInfo As String
    colInfo = "数量=" & dColQty & "列"
    colInfo = colInfo & "  単位="  & IIf(dColUnit  > 0, dColUnit  & "列", "未検出")
    colInfo = colInfo & "  単価="  & IIf(dColPrice > 0, dColPrice & "列", "未検出") & vbCrLf
    colInfo = colInfo & "金額="    & IIf(dColAmt   > 0, dColAmt   & "列", "未検出")
    colInfo = colInfo & "  備考="  & IIf(dColMemo  > 0, dColMemo  & "列", "未検出")
    colInfo = colInfo & "  差異="  & IIf(diffColInserted, dColDiff & "列（新規挿入）", "なし（差異ゼロ）")

    MsgBox "転記が完了しました！" & vbCrLf & vbCrLf & _
           "一致・転記  ：" & cntHit  & " 件" & vbCrLf & _
           "差異あり行  ：" & cntDiff & " 件" & vbCrLf & _
           "マッチなし  ：" & cntSkip & " 件" & vbCrLf & vbCrLf & _
           "【検索した転記先列】" & vbCrLf & colInfo, _
           vbInformation, "転記マクロ"

End Sub

---

◎ 貼り付け場所

Alt + F11 でVBAエディタを開き、「挿入 → 標準モジュール」で新しいモジュールを追加してください。そこにコードを貼り付けます。

◎ 保存形式に注意

マクロを含むブックは、必ず .xlsm（マクロ有効ブック） で保存してください。 .xlsx のまま保存するとマクロが消えます。これ、本当に多いミスなので気をつけてください。

◎ マクロが動かない場合

会社のPCでは、セキュリティポリシーでマクロが無効化されていることがあります。 その場合は「ファイル → オプション → トラストセンター → マクロの設定」を確認してください。 設定変更に管理者権限が必要な場合は、情報システム部門に相談しましょう。

◎ 見出し文字列が違う場合

コード冒頭の「見出し文字列」を、実際のシートに合わせて変更してください。

'--- ★ 見出し文字列（シートに合わせて変更可） ---
Const S_NO1   As String = "親番"    '← 「No1」などに変更OK
Const D_NO1   As String = "No1"    '← 転記表の見出しに合わせる
Const D_YQTY  As String = "予定数量" '← 「設計数量」などに変更OK

たとえば、転記表の親番見出しが「No1」ではなく「項番」であれば、D_NO1 = "項番" と変えるだけです。

次の章では、マクロの実行手順をステップバイステップで説明していきます。

---

テスト実行の手順｜A社を例に

マクロの実行方法を、A社の回答を例に説明します。

Step 1：マクロを実行する Alt + F8 を押して「回答を会社ブロックへ転記_縦横検索版」を選択し、「実行」をクリックします。

Step 2：回答書の親番先頭セルを選択する 案内メッセージが出たら、回答シート（A社シート）を開いて親番列の先頭データセルをクリックします。

ここが重要です。先頭データセルの1行上が見出し行になっている必要があります。 見出し行に「親番」「枝番」「数量」の文字がないとエラーになります。

Step 3：転記先の数量先頭セルを選択する 次の案内メッセージが出たら、転記表のA社ブロック・数量先頭セル（例：H3）をクリックします。

マクロが自動的に見出し行を上方向に検索し、数量・単位・単価・金額・備考の列を特定します。

Step 4：結果を確認する 処理が完了すると、以下の情報がメッセージで表示されます。

• 一致・転記：〇件
• 差異あり行：〇件
• マッチなし：〇件
• 【検索した転記先列】数量=8列　単位=9列　単価=10列…

「検索した転記先列」の番号が想定通りかを必ず確認してください。 ここが違っていたら、見出し文字列の不一致が原因です。

B社・C社も同様に、回答書のシートを切り替えて転記先を変えてそれぞれ実行します。

---

v4で進化した3つのポイント

v4の「縦横検索版」は、以前のバージョンから3つの大きな進化があります。

進化① 列番号ハードコードの廃止

以前のバージョンは、コード内に列番号を直接書いていました。

'旧バージョン（列番号ハードコード）
Const COL_NO1 As Long = 2       'B列 = No1
Const COL_NO2 As Long = 3       'C列 = No2

この方法の問題点は、列を1列でも追加・移動したとたんにコードを書き直す必要があることです。

v4では、見出し文字列を読んで列番号を動的に特定します。 列の順番が変わっても、見出しさえ合っていれば動作します。

'v4（見出し文字列で動的検索）
For c = 1 To 50
    sv = CStr(wsS.Cells(srcHeaderRow, c).Value)
    Select Case sv
        Case S_NO1:   sColNo1 = c   '← 「親番」が何列目にあってもOK
        Case S_QTY:   If sColQty = 0 Then sColQty = c
    End Select
Next c

進化② 名称・規格の差異チェックを追加

v3以前は数量と単位の差異しか検出できませんでした。 v4では名称と規格の差異チェックが加わりました。

見積書では、同じ項目でも業者によって名称の表現が違うことがあります。 たとえば発注者が「掘削A（軟岩）」と書いても、業者が「岩盤掘削 軟岩区分」と回答するケースです。 これは単なる表記ゆれかもしれませんし、工法の読み替えかもしれない。 差異を自動で可視化することで、見落としを防ぎます。

進化③ 差異列を自動挿入する方式に変更

v3以前は差異を備考欄に書き込んでいたため、業者の備考コメントと混在していました。 v4では差異列を別途自動挿入する方式に変更しています。

差異がある行が初めて現れた時点で、備考の右隣に「差異」列が自動で挿入されます。 差異がゼロの場合は列が挿入されず、シートがすっきりしたままです。

これらの進化で、v4は実務のさまざまなシート構成に対応できるようになりました。

---

差異の表示イメージ

マクロ実行後、差異があった行の「差異」列にはこんな内容が記録されます。

数量と単位の両方に差異がある場合

数量（予定：20　→回答：1）
単位（予定：m3　→回答：ヶ所）

名称と規格に差異がある場合

名称（予定：掘削A　→回答：岩盤掘削）
規格（予定：　　　 →回答：人力含む）

差異がない場合： 差異列のそのセルは空欄のままです。

差異列にテキストが入っている行だけを確認すればいいので、全件を目視で確認していた頃とは作業の密度がグッと違います。

---

よくあるエラーと対処法

マクロを実行して「あれ？動かない」となったとき、慌てなくて大丈夫です。 よくあるパターンと対処法を3つまとめました。

エラー	よくある原因	対処法
「見出し行が見つかりません」エラー	先頭データセルの1行上が空行になっている、または見出し文字列が違う	先頭データセルが見出し行の直下になっているか確認する。見出し文字列をコード冒頭の定数に合わせる
実行時エラー 1004	シートが保護されている、または非表示シートを操作しようとしている	「校閲 → シート保護の解除」を実行してからマクロを動かす
マッチなし件数が多い	回答書の親番・枝番が転記表と表記が違う（全角/半角、スペースの有無など）	どちらかに表記を統一する。Trim() や StrConv() で前処理する方法もある

やってはいけないこと：エラーが出たときに、焦ってデータを手動で修正すること。 まずはマクロを止めて（Esc キー）、原因を特定してから再実行しましょう。

万が一に備えて、マクロを実行する前に必ずファイルのバックアップを取ってください。 ファイル名に日付を入れて別名保存するだけでOKです。

⚠️ やってはいけないこと：バックアップなしで上書き実行。復元できません。

---

実務での運用フロー

マクロを導入したら、チェックの流れも見直しましょう。

Step 1：マクロで一次スクリーニング → 全項目を自動突合し、数量・単位・単価・金額・備考を転記。差異を「差異」列に記録する。

Step 2：差異列のある行に集中点検 → 「差異」列に内容が記載された行だけを重点的に確認する。 → なぜ差異が生じているのか、各社の見積内訳書を精査する。

Step 3：チームで最終判断 → 差異の原因が技術的な判断によるものなら、プロジェクトマネージャーを含めた合議で採用数量を決定する。

確認の対象を「全件」から「差異のある項目だけ」に絞り込む。 これだけで、1箇所あたりの確認密度がグッと高まります。

---

このマクロの一番の目的

ここまで読んでいただいた方はもうお気づきだと思いますが、今回のマクロの目的は転記の自動化ではありません。

目的は、確認の省力化です。

Excel作業では「自動化すれば正義」と思われがちです。 でも、見積比較の仕事では差異を見ること自体が重要な仕事なんです。

だからこそ、

• 人が確認する
• Excelが整理する

この役割分担が、一番安全で、一番速い。

「起きてから対処する」のではなく、「起こさないための仕組み」を作る。 今回のマクロは、その仕組みの第一歩です。

---

まとめ｜今日やるべきこと

この記事で紹介した内容をおさらいします。

• 見積比較の転記作業を半自動化するVBAマクロ（縦横検索版 v4）
• 親番＋枝番で自動突合し、数量・単位・単価・金額・備考をすべて転記
• 名称・規格・数量・単位の4項目を差異チェック（差異は「差異」列に自動挿入して記録）
• 見出し文字列で列を動的検索するため、列の追加・変更に強い
• 差異ゼロなら「差異」列は挿入されない（シートがすっきりしたまま）

まずは、次の3つだけ今日中にやってみてください。

1. VBAエディタを開く（Alt + F11）
2. 標準モジュールにコードを貼り付ける
3. A社の回答だけでテスト実行する

最初から完璧を目指す必要はありません。 小さなデータで1回動かしてみれば、「あ、これは使えるな」と実感できるはずです。

慣れてきたら、転記表のレイアウトを見直して見出し文字列を統一してみてください。 余裕が出てきたら、コードを読み解いて自分なりにカスタマイズしてみるのも良い練習になります。

あせらず、くさらず、あきらめず。

小さな仕組み化を積み重ねていけば、Excel作業は確実に楽になります。 ぜひあなたの現場でも試してみてください。

あなたのフィードバックが次の記事のヒントになります。 「ここが分かりにくかった」「うちの現場ではこう使ってるよ」「項目を変えたコードが欲しい」などといった声があれば、ぜひ教えてください。