VBA×生成AIで作る契約書自動レビューシステム【リスク検出・修正案生成】

はじめに

初級編、中級編と続いてきた本シリーズの完結編です。

初級編ではExcel単一セルの校正、中級編では50個のWord文書の一括レビューを実現しました。

今回の上級編では、ビジネス文書の中でも特に重要な「契約書」を専門的にレビューするシステムを構築します。

中級編の最後に、予告として

次回「上級編」では以下の機能を追加します：
• Power Automate連携 - SharePoint監視→自動レビュー
• 承認ワークフロー - レビュー結果に応じた自動承認
• 監査ログ・統計 - 処理履歴の完全記録
• Teams通知 - 処理完了を自動通知
• Power BIダッシュボード - 文書品質の可視化
「VBA×Power Automate×生成AIで作る企業向け文書管理システム」

と書きましたが、結果的にすべてPowerAutomateでできると分かったため、VBAと生成AIの連携記事にはならないと思い、内容を変更しました。
待ってくださった方は申し訳ございません。

上級編で実現すること

中級編との違いを表で示します。

項目	中級編	上級編（契約書レビュー）
対象文書	一般的な報告書	契約書（法的文書）
レビュー観点	文体・表現	法的リスク・条項の妥当性
処理段階	1回のレビュー	4段階レビュー
出力形式	Excelレポート	Word文書にコメント挿入
リスク評価	なし	高・中・低の3段階
修正案	簡単な指摘のみ	具体的な修正案を生成
類似条項検索	なし	過去契約書から検索（RAG）
可視化	テキスト	ダッシュボード（Excel）

追加される7つの主要機能は以下の通りです。

条項自動識別 - 秘密保持、支払条件、解約条件等を自動分類
リスク評価 - 各条項のリスクレベルを3段階で評価
法的問題点検出 - 一方的に不利な条項を自動検出
修正案生成 - 具体的な修正文を提案
Word文書コメント挿入 - リスクレベルに応じて色分けコメント
過去契約書検索 - 類似条項から学習（RAG）
リスクダッシュボード - 契約書全体のリスクを可視化

想定される実務シーン

シーン1：取引先から送られてきた契約書のレビュー

従来の手動プロセス

【月曜日 10:00】
営業部が取引先から契約書（Word）を受領
  ↓
【10:30】
法務部に確認依頼メール
  ↓
【翌日 15:00】
法務担当者が契約書を精読（30分）
問題点をメールで回答
  ↓
【翌々日 10:00】
営業部が修正版を作成
再度法務部に確認依頼
  ↓
【翌々日 15:00】
法務担当者が再レビュー（20分）
  ↓
【翌々日 17:00】
最終承認

所要時間：3日間
法務担当者の工数：50分

上級編システム導入後

【月曜日 10:00】
営業部が取引先から契約書を受領
  ↓
【10:01】
Excelマクロを実行（Alt+F8）
  ↓
【10:02】
契約書レビュー完了（1分）
- リスク高：3箇所（赤コメント）
- リスク中：5箇所（黄コメント）
- リスク低：2箇所（緑コメント）
- 修正案：すべて自動生成済み
  ↓
【10:10】
営業部が修正案を確認、採用
  ↓
【10:20】
法務部に最終確認依頼（重要箇所のみ）
  ↓
【10:30】
法務担当者が赤コメント箇所のみ確認（5分）
  ↓
【10:35】
承認

所要時間：35分
法務担当者の工数：5分

効果（想定）

処理時間：3日間 → 35分（99.2%削減）
法務工数：50分 → 5分（90%削減）
見落としリスク：大幅削減

このように、手動で契約書確認をすると見落としなどのリスクもあったのですが、
それを防ぐことができるようになるというのが大きなメリットです。

シーン2：自社で作成した契約書の事前チェック

従来

営業部が契約書ドラフト作成
  ↓
法務部に確認依頼
  ↓
法務部が精読（1時間）
  ↓
修正指示
  ↓
営業部が修正
  ↓
再確認（30分）
  ↓
承認

所要時間：2日間
法務工数：1.5時間

システム導入後

営業部が契約書ドラフト作成
  ↓
自分でマクロ実行（1分）
  ↓
リスク箇所を確認、即座に修正
  ↓
法務部に確認依頼（問題なしの見込み）
  ↓
法務部が最終確認（10分）
  ↓
承認

所要時間：30分
法務工数：10分

ここで重要なのは、法務部と契約書に関するルールなどの意識合わせをきちんとしておく必要があるということです。逆に言えば、そこをクリアしていれば自動化ツールにチェック項目を組み込める＝ヒューマンエラーが削減されるということですね。

システム全体像

処理フロー

┌──────────────────────┐
│  契約書（Word/PDF）   │
└──────┬───────────────┘
       │
       ▼
┌──────────────────────┐
│  VBA：文書読み込み    │
│  - 条項ごとに分割     │
│  - 見出し抽出         │
└──────┬───────────────┘
       │
       ▼
┌──────────────────────┐
│  第1段階：条項識別    │
│  OpenAI API          │
│  - 秘密保持条項       │
│  - 支払条件           │
│  - 解約条件 等        │
└──────┬───────────────┘
       │
       ▼
┌──────────────────────┐
│  第2段階：リスク評価  │
│  OpenAI API          │
│  - 高リスク（赤）     │
│  - 中リスク（黄）     │
│  - 低リスク（緑）     │
└──────┬───────────────┘
       │
       ▼
┌──────────────────────┐
│  第3段階：問題点検出  │
│  OpenAI API          │
│  - 一方的に不利な条項 │
│  - 曖昧な表現         │
│  - 欠落している条項   │
└──────┬───────────────┘
       │
       ▼
┌──────────────────────┐
│  第4段階：修正案生成  │
│  OpenAI API          │
│  - 具体的な修正文     │
│  - 根拠説明           │
└──────┬───────────────┘
       │
       ▼
┌──────────────────────┐
│  VBA：結果を統合      │
│  - Wordコメント挿入   │
│  - Excelダッシュボード│
└──────┬───────────────┘
       │
       ▼
┌──────────────────────┐
│  レビュー済み契約書   │
│  + ダッシュボード     │
└───────────────────────┘

必要なもの

1. Excel VBA

役割

契約書の読み込み
AIへのリクエスト送信
結果の統合と出力

必要なバージョン

Excel 2016以降（VBA対応）

2. Microsoft Word

役割

契約書の読み込み
コメント挿入

必要なバージョン

Word 2016以降

3. OpenAI API

役割

条項識別
リスク評価
問題点検出
修正案生成

必要なもの

OpenAI APIキー
https://platform.openai.com で取得

料金目安

gpt-4o：入力$2.50/1M tokens、出力$10.00/1M tokens
10ページの契約書1件あたり約10～30円
月20件レビューしても約200～600円

推奨モデル

gpt-4o（精度重視）
gpt-4o-mini（コスト重視）

4. 契約書サンプル

準備するもの

レビュー対象の契約書（Word形式推奨）
（オプション）過去の契約書データベース（RAG用）

手順（ステップ1～ステップ5）

それでは、実際にシステムを構築していきます。

全体の所要時間：約30分

ステップ1：前提条件の確認（5分）

●チェックリスト

以下を確認してください

Excel 2016以降がインストールされている
Word 2016以降がインストールされている
OpenAI APIキーを持っている
レビュー対象の契約書（Word形式）を準備している

すべてチェックできましたか

→ はい：次のステップへ進んでください

ステップ2：VBAマクロの配置（10分）

2-1. Excelファイルを作成

Excelを起動
新規ブックを開く
「名前を付けて保存」

ファイル名：契約書レビューシステム.xlsm
ファイルの種類：Excelマクロ有効ブック (*.xlsm)
保存場所：デスクトップ

2-2. VBAエディタを開く

Alt + F11 を押す
VBAエディタが開きます

2-3. 標準モジュールを追加

メニューから「挿入」→「標準モジュール」
左側のプロジェクトエクスプローラーに「Module1」が追加されます

2-4. VBAコードを貼り付け

以下「VBAコード全文」セクションから全コードをコピー
VBAエディタのModule1に貼り付け（Ctrl + V）

以下のコードをExcelのVBAエディタに貼り付けてください。
※変数は分かりやすくするためにあえて日本語で書いています

Option Explicit

' ===================================
' 契約書自動レビューシステム（上級編）
' VBA×生成AI
' ===================================

' API設定
Private Const API_KEY As String = "YOUR_OPENAI_API_KEY"
Private Const API_ENDPOINT As String = "https://api.openai.com/v1/chat/completions"
Private Const API_MODEL As String = "gpt-4o"

' データ構造
Private Type ClauseInfo
    番号 As Long
    見出し As String
    本文 As String
    種類 As String
    リスクレベル As String
    問題点 As String
    修正案 As String
    根拠 As String
End Type

Private Type ReviewResult
    契約書名 As String
    総条項数 As Long
    高リスク数 As Long
    中リスク数 As Long
    低リスク数 As Long
    条項情報() As ClauseInfo
End Type

' ======================================
' メイン処理
' ======================================

' 契約書レビューシステム（メイン）
Sub 契約書自動レビューシステム()
    Dim filePath As String
    Dim result As ReviewResult
    Dim startTime As Double
    
    startTime = Timer
    
    ' ファイル選択
    filePath = Application.GetOpenFilename( _
        "Word文書 (*.docx),*.docx,すべてのファイル (*.*),*.*", _
        , "レビューする契約書を選択してください")
    
    If filePath = "False" Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 処理開始
    MsgBox "契約書レビューを開始します。" & vbCrLf & _
           "処理には数分かかる場合があります。", vbInformation
    
    ' 1. 契約書を読み込み、条項ごとに分割
    result = ProcessContract(filePath)
    
    ' 2. Wordファイルにコメントを挿入
    Call InsertCommentsToWord(filePath, result)
    
    ' 3. Excelにダッシュボードを作成
    Call CreateDashboard(result)
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    ' 完了通知
    MsgBox "レビュー完了！" & vbCrLf & _
           "総条項数: " & result.総条項数 & vbCrLf & _
           "高リスク: " & result.高リスク数 & "件" & vbCrLf & _
           "中リスク: " & result.中リスク数 & "件" & vbCrLf & _
           "低リスク: " & result.低リスク数 & "件" & vbCrLf & _
           "処理時間: " & Round(Timer - startTime, 0) & "秒", vbInformation
End Sub

' ======================================
' 契約書処理
' ======================================

' 契約書を処理
Private Function ProcessContract(filePath As String) As ReviewResult
    Dim wordApp As Object
    Dim doc As Object
    Dim clauses() As ClauseInfo
    Dim clauseCount As Long
    Dim i As Long
    Dim result As ReviewResult
    
    ' Word起動
    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    If wordApp Is Nothing Then
        Set wordApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    
    wordApp.Visible = False
    Set doc = wordApp.Documents.Open(filePath, ReadOnly:=True)
    
    ' 条項を抽出
    clauses = ExtractClauses(doc)
    clauseCount = UBound(clauses) - LBound(clauses) + 1
    
    ' 各条項をAIでレビュー
    For i = LBound(clauses) To UBound(clauses)
        Application.StatusBar = "レビュー中... (" & i - LBound(clauses) + 1 & "/" & clauseCount & ")"
        
        ' 4段階レビュー
        Call ReviewClause(clauses(i))
        
        DoEvents
    Next i
    
    ' 結果を集計
    result.契約書名 = doc.Name
    result.総条項数 = clauseCount
    result.条項情報 = clauses
    
    For i = LBound(clauses) To UBound(clauses)
        Select Case clauses(i).リスクレベル
            Case "高"
                result.高リスク数 = result.高リスク数 + 1
            Case "中"
                result.中リスク数 = result.中リスク数 + 1
            Case "低"
                result.低リスク数 = result.低リスク数 + 1
        End Select
    Next i
    
    doc.Close False
    Application.StatusBar = False
    
    ProcessContract = result
End Function

' 契約書から条項を抽出
Private Function ExtractClauses(doc As Object) As ClauseInfo()
    Dim clauses() As ClauseInfo
    Dim para As Object
    Dim clauseCount As Long
    Dim currentClause As String
    Dim currentHeading As String
    Dim i As Long
    
    clauseCount = 0
    ReDim clauses(1 To 100)
    
    ' 段落を走査
    For Each para In doc.Paragraphs
        Dim paraText As String
        paraText = Trim(para.Range.Text)
        
        If Len(paraText) > 0 Then
            ' 見出しスタイルの場合
            If InStr(para.Style, "見出し") > 0 Or _
               para.OutlineLevel <= 3 Then
                
                ' 前の条項を保存
                If Len(currentClause) > 0 Then
                    clauseCount = clauseCount + 1
                    If clauseCount > UBound(clauses) Then
                        ReDim Preserve clauses(1 To UBound(clauses) + 50)
                    End If
                    
                    clauses(clauseCount).番号 = clauseCount
                    clauses(clauseCount).見出し = currentHeading
                    clauses(clauseCount).本文 = currentClause
                End If
                
                ' 新しい条項開始
                currentHeading = paraText
                currentClause = ""
            Else
                ' 本文を追加
                currentClause = currentClause & paraText & vbCrLf
            End If
        End If
    Next para
    
    ' 最後の条項を保存
    If Len(currentClause) > 0 Then
        clauseCount = clauseCount + 1
        clauses(clauseCount).番号 = clauseCount
        clauses(clauseCount).見出し = currentHeading
        clauses(clauseCount).本文 = currentClause
    End If
    
    ' 配列サイズを調整
    ReDim Preserve clauses(1 To clauseCount)
    
    ExtractClauses = clauses
End Function

' 1つの条項をAIでレビュー（4段階）
Private Sub ReviewClause(ByRef clause As ClauseInfo)
    Dim prompt As String
    Dim response As String
    
    ' 第1段階：条項の種類を識別
    prompt = "以下の契約書の条項について、その種類を識別してください。" & vbLf & vbLf
    prompt = prompt & "【条項】" & vbLf
    prompt = prompt & "見出し: " & clause.見出し & vbLf
    prompt = prompt & "本文: " & clause.本文 & vbLf & vbLf
    prompt = prompt & "以下のいずれかに分類してください" & vbLf
    prompt = prompt & "- 秘密保持条項" & vbLf
    prompt = prompt & "- 支払条件" & vbLf
    prompt = prompt & "- 納期・納品条件" & vbLf
    prompt = prompt & "- 解約条件" & vbLf
    prompt = prompt & "- 損害賠償・免責条項" & vbLf
    prompt = prompt & "- 知的財産権" & vbLf
    prompt = prompt & "- 一般条項（準拠法、管轄裁判所等）" & vbLf
    prompt = prompt & "- その他" & vbLf & vbLf
    prompt = prompt & "【回答形式】種類名のみ回答してください。"
    
    response = CallOpenAI(prompt, 0.1)
    clause.種類 = Trim(response)
    
    ' 第2～4段階：リスク評価、問題点、修正案を一度に取得
    prompt = "以下の契約書の条項について、法的リスクを評価し、問題点を指摘し、修正案を提案してください。" & vbLf & vbLf
    prompt = prompt & "【条項】" & vbLf
    prompt = prompt & "種類: " & clause.種類 & vbLf
    prompt = prompt & "見出し: " & clause.見出し & vbLf
    prompt = prompt & "本文: " & clause.本文 & vbLf & vbLf
    prompt = prompt & "【評価観点】" & vbLf
    prompt = prompt & "1. 一方的に不利な内容になっていないか" & vbLf
    prompt = prompt & "2. 曖昧な表現で解釈の余地がないか" & vbLf
    prompt = prompt & "3. 必要な条件が欠落していないか" & vbLf
    prompt = prompt & "4. 過度に厳しい条件になっていないか" & vbLf & vbLf
    prompt = prompt & "【重要】以下のJSON形式で必ず出力してください" & vbLf
    prompt = prompt & "{" & vbLf
    prompt = prompt & "  ""リスクレベル"": ""高"" または ""中"" または ""低""," & vbLf
    prompt = prompt & "  ""問題点"": ""具体的な問題点の説明""," & vbLf
    prompt = prompt & "  ""修正案"": ""具体的な修正文""," & vbLf
    prompt = prompt & "  ""根拠"": ""リスク判定の根拠""" & vbLf
    prompt = prompt & "}"
    
    response = CallOpenAI(prompt, 0.3)
    
    ' JSON解析
    clause.リスクレベル = ExtractJsonField(response, "リスクレベル")
    clause.問題点 = ExtractJsonField(response, "問題点")
    clause.修正案 = ExtractJsonField(response, "修正案")
    clause.根拠 = ExtractJsonField(response, "根拠")
    
    ' デフォルト値設定
    If clause.リスクレベル = "" Then clause.リスクレベル = "低"
    If clause.問題点 = "" Then clause.問題点 = "特に問題は検出されませんでした。"
    If clause.修正案 = "" Then clause.修正案 = "修正不要"
End Sub

' ======================================
' OpenAI API
' ======================================

' OpenAI APIを呼び出し
Private Function CallOpenAI(prompt As String, temperature As Double) As String
    Dim http As Object
    Dim jsonRequest As String
    Dim response As String
    
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    jsonRequest = "{" & _
        """model"":""" & API_MODEL & """," & _
        """messages"":[{""role"":""user"",""content"":" & JsonEncode(prompt) & "}]," & _
        """temperature"":" & temperature & _
    "}"
    
    On Error GoTo ErrorHandler
    
    http.Open "POST", API_ENDPOINT, False
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "Authorization", "Bearer " & API_KEY
    http.send jsonRequest
    
    If http.Status = 200 Then
        response = http.responseText
        
        Dim contentStart As Long
        Dim contentEnd As Long
        contentStart = InStr(response, """content"":""")
        
        If contentStart > 0 Then
            contentStart = contentStart + 11
            contentEnd = InStr(contentStart, response, """")
            response = Mid(response, contentStart, contentEnd - contentStart)
            response = Replace(response, "\n", vbCrLf)
            response = Replace(response, "\""", """")
        End If
        
        CallOpenAI = response
    Else
        CallOpenAI = "[API Error: " & http.Status & "]"
    End If
    
    Exit Function
    
ErrorHandler:
    CallOpenAI = "[API Error: " & Err.Description & "]"
End Function

' JSON文字列をエンコード
Private Function JsonEncode(text As String) As String
    Dim result As String
    result = text
    result = Replace(result, "\", "\\")
    result = Replace(result, """", "\""")
    result = Replace(result, vbCrLf, "\n")
    result = Replace(result, vbCr, "\n")
    result = Replace(result, vbLf, "\n")
    JsonEncode = """" & result & """"
End Function

' JSONフィールドを抽出
Private Function ExtractJsonField(jsonText As String, fieldName As String) As String
    Dim startPos As Long
    Dim endPos As Long
    Dim searchStr As String
    Dim value As String
    Dim i As Long
    Dim char As String
    Dim prevChar As String
    
    searchStr = """" & fieldName & """:"
    startPos = InStr(jsonText, searchStr)
    
    If startPos = 0 Then
        ExtractJsonField = ""
        Exit Function
    End If
    
    startPos = startPos + Len(searchStr)
    
    Do While startPos <= Len(jsonText)
        char = Mid(jsonText, startPos, 1)
        If char = """" Then
            startPos = startPos + 1
            Exit Do
        ElseIf char <> " " Then
            Exit Do
        End If
        startPos = startPos + 1
    Loop
    
    i = startPos
    Do While i <= Len(jsonText)
        char = Mid(jsonText, i, 1)
        prevChar = Mid(jsonText, i - 1, 1)
        
        If (char = """" And prevChar <> "\") Or char = "," Or char = "}" Then
            endPos = i
            Exit Do
        End If
        i = i + 1
    Loop
    
    If endPos = 0 Then
        ExtractJsonField = ""
        Exit Function
    End If
    
    value = Mid(jsonText, startPos, endPos - startPos)
    value = Replace(value, """", "")
    value = Replace(value, ",", "")
    value = Replace(value, "}", "")
    value = Trim(value)
    value = Replace(value, "\n", vbCrLf)
    value = Replace(value, "\""", """")
    
    ExtractJsonField = value
End Function

' ======================================
' Word文書へのコメント挿入
' ======================================

' Wordファイルにコメントを挿入
Private Sub InsertCommentsToWord(filePath As String, result As ReviewResult)
    Dim wordApp As Object
    Dim doc As Object
    Dim para As Object
    Dim i As Long
    Dim clauseIndex As Long
    Dim commentText As String
    Dim colorCode As Long
    Dim outputPath As String
    
    ' Word起動
    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    If wordApp Is Nothing Then
        Set wordApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    
    wordApp.Visible = True
    Set doc = wordApp.Documents.Open(filePath)
    
    clauseIndex = 1
    
    ' 段落を走査してコメント挿入
    For Each para In doc.Paragraphs
        If clauseIndex > result.総条項数 Then Exit For
        
        ' 見出しを検索
        If InStr(para.Range.Text, result.条項情報(clauseIndex).見出し) > 0 Then
            
            ' リスクレベルに応じて色を設定
            Select Case result.条項情報(clauseIndex).リスクレベル
                Case "高"
                    colorCode = RGB(255, 200, 200) ' 赤系
                Case "中"
                    colorCode = RGB(255, 255, 200) ' 黄系
                Case "低"
                    colorCode = RGB(200, 255, 200) ' 緑系
                Case Else
                    colorCode = RGB(255, 255, 255) ' 白
            End Select
            
            ' 背景色を設定
            para.Range.HighlightColorIndex = GetHighlightColor(result.条項情報(clauseIndex).リスクレベル)
            
            ' コメントテキスト作成
            commentText = "【" & result.条項情報(clauseIndex).種類 & "】" & vbCrLf & vbCrLf
            commentText = commentText & "リスクレベル: " & result.条項情報(clauseIndex).リスクレベル & vbCrLf & vbCrLf
            commentText = commentText & "【問題点】" & vbCrLf
            commentText = commentText & result.条項情報(clauseIndex).問題点 & vbCrLf & vbCrLf
            commentText = commentText & "【修正案】" & vbCrLf
            commentText = commentText & result.条項情報(clauseIndex).修正案 & vbCrLf & vbCrLf
            commentText = commentText & "【根拠】" & vbCrLf
            commentText = commentText & result.条項情報(clauseIndex).根拠
            
            ' コメント追加
            doc.Comments.Add para.Range, commentText
            
            clauseIndex = clauseIndex + 1
        End If
    Next para
    
    ' レビュー済みファイルとして保存
    outputPath = Replace(filePath, ".docx", "_レビュー済み.docx")
    doc.SaveAs2 outputPath
    
    MsgBox "レビュー結果をWord文書に挿入しました。" & vbCrLf & _
           outputPath, vbInformation
End Sub

' ハイライト色を取得
Private Function GetHighlightColor(riskLevel As String) As Long
    Select Case riskLevel
        Case "高"
            GetHighlightColor = 6  ' 赤
        Case "中"
            GetHighlightColor = 7  ' 黄
        Case "低"
            GetHighlightColor = 4  ' 緑
        Case Else
            GetHighlightColor = 0  ' なし
    End Select
End Function

' ======================================
' Excelダッシュボード作成
' ======================================

' ダッシュボードを作成
Private Sub CreateDashboard(result As ReviewResult)
    Dim ws As Worksheet
    Dim i As Long
    
    ' 既存のダッシュボードシートを削除
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets("契約書レビューダッシュボード").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    ' 新しいシートを作成
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "契約書レビューダッシュボード"
    
    ' タイトル
    With ws
        .Range("A1").Value = "契約書レビューダッシュボード"
        .Range("A1").Font.Size = 16
        .Range("A1").Font.Bold = True
        
        .Range("A2").Value = "契約書名: " & result.契約書名
        .Range("A3").Value = "レビュー日時: " & Format(Now, "yyyy/mm/dd hh:mm:ss")
        
        ' サマリー
        .Range("A5").Value = "リスクサマリー"
        .Range("A5").Font.Bold = True
        .Range("A5").Font.Size = 12
        
        .Range("A6").Value = "総条項数"
        .Range("B6").Value = result.総条項数
        .Range("A7").Value = "高リスク"
        .Range("B7").Value = result.高リスク数
        .Range("B7").Interior.Color = RGB(255, 200, 200)
        .Range("A8").Value = "中リスク"
        .Range("B8").Value = result.中リスク数
        .Range("B8").Interior.Color = RGB(255, 255, 200)
        .Range("A9").Value = "低リスク"
        .Range("B9").Value = result.低リスク数
        .Range("B9").Interior.Color = RGB(200, 255, 200)
        
        ' 条項詳細
        .Range("A11").Value = "条項詳細"
        .Range("A11").Font.Bold = True
        .Range("A11").Font.Size = 12
        
        ' ヘッダー
        .Range("A12").Value = "No"
        .Range("B12").Value = "見出し"
        .Range("C12").Value = "種類"
        .Range("D12").Value = "リスク"
        .Range("E12").Value = "問題点"
        .Range("F12").Value = "修正案"
        
        .Range("A12:F12").Font.Bold = True
        .Range("A12:F12").Interior.Color = RGB(68, 114, 196)
        .Range("A12:F12").Font.Color = RGB(255, 255, 255)
        
        ' データ
        For i = 1 To result.総条項数
            .Cells(12 + i, 1).Value = result.条項情報(i).番号
            .Cells(12 + i, 2).Value = result.条項情報(i).見出し
            .Cells(12 + i, 3).Value = result.条項情報(i).種類
            .Cells(12 + i, 4).Value = result.条項情報(i).リスクレベル
            .Cells(12 + i, 5).Value = result.条項情報(i).問題点
            .Cells(12 + i, 6).Value = result.条項情報(i).修正案
            
            ' リスクレベルに応じて色分け
            Select Case result.条項情報(i).リスクレベル
                Case "高"
                    .Cells(12 + i, 4).Interior.Color = RGB(255, 200, 200)
                Case "中"
                    .Cells(12 + i, 4).Interior.Color = RGB(255, 255, 200)
                Case "低"
                    .Cells(12 + i, 4).Interior.Color = RGB(200, 255, 200)
            End Select
        Next i
        
        ' 列幅調整
        .Columns("A").ColumnWidth = 5
        .Columns("B").ColumnWidth = 30
        .Columns("C").ColumnWidth = 20
        .Columns("D").ColumnWidth = 10
        .Columns("E").ColumnWidth = 50
        .Columns("F").ColumnWidth = 50
        
        .Columns("E:F").WrapText = True
    End With
    
    ws.Activate
End Sub

' ======================================
' ユーティリティ
' ======================================

' 全Wordインスタンスを閉じる
Sub Word終了()
    Dim wordApp As Object
    
    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    If Not wordApp Is Nothing Then
        wordApp.Quit
        Set wordApp = Nothing
        MsgBox "Wordアプリケーションを終了しました。", vbInformation
    Else
        MsgBox "起動中のWordアプリケーションはありません。", vbInformation
    End If
    On Error GoTo 0
End Sub

2-5. 設定を変更

コードの上部にある設定値を変更します

9行目：OpenAI APIキー

Private Const API_KEY As String = "YOUR_OPENAI_API_KEY"

↓ 変更（自分が持っているAPIキーを入力する）

Private Const API_KEY As String = "sk-proj-あなたのAPIキー"

11行目：使用するAIモデル（オプション）

Private Const API_MODEL As String = "gpt-4o"

コスト重視の場合は以下に変更

Private Const API_MODEL As String = "gpt-4o-mini"

2-6. 保存

Ctrl + S で保存
VBAエディタを閉じる（Alt + Q）

ステップ3：テスト用契約書の準備（5分）

3-1. サンプル契約書を作成

Wordを開く
以下のテキストを入力（簡単なサンプル）

業務委託契約書

第1条（目的）
本契約は、甲が乙に対して、○○業務を委託し、乙がこれを受託することを目的とする。

第2条（委託業務の内容）
甲が乙に委託する業務の内容は、以下のとおりとする。
1. ○○に関する業務
2. ○○に関する業務

第3条（委託料）
甲は乙に対し、本件業務の対価として、金○○円を支払うものとする。
支払期日は、業務完了後30日以内とする。

第4条（秘密保持）
乙は、本契約の履行により知り得た甲の秘密情報を第三者に開示してはならない。
この義務は、本契約終了後も存続するものとする。

第5条（損害賠償）
乙の責に帰すべき事由により甲に損害が生じた場合、乙は甲に対し、
その全ての損害を賠償するものとする。

第6条（契約の解除）
甲は、いつでも本契約を解除することができるものとする。

第7条（準拠法）
本契約は日本法に準拠する。

第8条（合意管轄）
本契約に関する一切の紛争については、東京地方裁判所を専属的合意管轄裁判所とする。

名前を付けて保存

ファイル名：サンプル契約書.docx
保存場所：デスクトップ

ステップ4：レビュー実行（5分）

4-1. マクロを実行

Excelファイル「契約書レビューシステム.xlsm」を開く
Alt + F8 を押す
マクロ一覧から「契約書自動レビューシステム」を選択
「実行」をクリック

4-2. ファイルを選択

ファイル選択ダイアログが表示されます
デスクトップの「サンプル契約書.docx」を選択
「開く」をクリック

4-3. 処理を待つ

処理中メッセージが表示されます

契約書レビューを開始します。
処理には数分かかる場合があります。

進行状況がステータスバーに表示されます

レビュー中... (1/8)
レビュー中... (2/8)
...

4-4. 結果を確認

完了メッセージ

レビュー完了
総条項数: 8
高リスク: 2件
中リスク: 3件
低リスク: 3件
処理時間: 約90秒

ステップ5：レビュー結果の確認（5分）

5-1. Word文書を確認

自動的にWordが開きます
ファイル名：「サンプル契約書_レビュー済み.docx」
各条項に色付きハイライトとコメントが挿入されています

確認ポイント

赤ハイライト：高リスク条項
黄ハイライト：中リスク条項
緑ハイライト：低リスク条項

各コメントには以下が含まれます

【損害賠償・免責条項】

リスクレベル: 高

【問題点】
「全ての損害」という表現が過度に広範で、
乙に一方的に不利な内容となっています。
上限額の設定や免責事由の明記がありません。

【修正案】
「乙の責に帰すべき事由により甲に損害が生じた場合、
乙は甲に対し、委託料の範囲内でその損害を賠償するものとする。
ただし、乙の故意または重過失による場合を除く。」

【根拠】
損害賠償責任は無制限ではなく、
契約金額の範囲内に制限することが一般的です。

5-2. Excelダッシュボードを確認

Excelに戻る
「契約書レビューダッシュボード」シートが自動作成されています
以下の情報が表示されています

リスクサマリー

総条項数:    8
高リスク:    2 （赤背景）
中リスク:    3 （黄背景）
低リスク:    3 （緑背景）

条項詳細テーブル

No	見出し	種類	リスク	問題点	修正案
1	第1条（目的）	一般条項	低	特に問題は検出されませんでした	修正不要
2	第2条（委託業務の内容）	納期・納品条件	中	業務内容が「○○」と抽象的	具体的な業務内容を明記
5	第5条（損害賠償）	損害賠償・免責条項	高	無制限の損害賠償責任	上限額を設定
6	第6条（契約の解除）	解約条件	高	甲のみが一方的に解除可能	双方の解除権を明記

ステップ6：完成

これで実現できたこと

契約書を数分で自動レビュー
法的リスクを3段階で評価
具体的な問題点を指摘
修正案を自動生成
Word文書に直接コメント挿入
Excelでリスクを可視化

実際の契約書レビュー例

例1：高リスクと判定された条項

元の条項

第10条（知的財産権）
本業務の遂行により生じた一切の成果物に関する知的財産権は、
すべて甲に帰属するものとする。

AIレビュー結果

種類: 知的財産権
リスクレベル: 高

【問題点】
乙が既に保有している知的財産権や、
本業務と無関係に開発したツール・ノウハウまで
甲に帰属することになり、乙に著しく不利です。

【修正案】
「本業務の遂行により新たに創作された成果物に関する知的財産権は
甲に帰属する。ただし、乙が従前より保有する知的財産権、
および本業務と無関係に開発したツール・ノウハウについては、
この限りでない。」

【根拠】
既存の知的財産権まで譲渡することは過度な要求であり、
業務範囲を明確に限定すべきです。

例2：中リスクと判定された条項

元の条項

第8条（納期）
納期は令和○年○月○日とする。
やむを得ない事由により遅延する場合は、
甲乙協議の上、納期を変更することができる。

AIレビュー結果

種類: 納期・納品条件
リスクレベル: 中

【問題点】
「やむを得ない事由」の定義が曖昧で、
解釈の余地があります。また、協議が整わない場合の
取り扱いが明記されていません。

【修正案】
「納期は令和○年○月○日とする。
天災地変、法令の制定改廃、その他乙の責に帰すべからざる事由により
納期の遵守が困難となった場合、乙は速やかに甲に通知し、
甲乙協議の上、合理的な範囲で納期を延長することができる。」

【根拠】
不可抗力の範囲を明確化し、協議プロセスを具体化することで
紛争を予防できます。

例3：低リスクと判定された条項

元の条項

第12条（準拠法）
本契約は日本法に準拠するものとする。

AIレビュー結果

種類: 一般条項（準拠法、管轄裁判所等）
リスクレベル: 低

【問題点】
特に問題は検出されませんでした。
標準的な準拠法条項です。

【修正案】
修正不要

【根拠】
日本国内の取引において、日本法を準拠法とすることは
一般的かつ合理的です。

カスタマイズ例

カスタマイズ1：業種別ルールの追加

IT業界向けにカスタマイズ

' ReviewClause関数内のプロンプトに追加
prompt = prompt & "【IT業界特有のチェックポイント】" & vbLf
prompt = prompt & "- ソースコードの著作権帰属は明確か" & vbLf
prompt = prompt & "- SLA（サービスレベル）が具体的に定義されているか" & vbLf
prompt = prompt & "- データ保護・個人情報保護の条項があるか" & vbLf
prompt = prompt & "- セキュリティインシデント発生時の対応が明記されているか" & vbLf

建設業界向けにカスタマイズ

prompt = prompt & "【建設業界特有のチェックポイント】" & vbLf
prompt = prompt & "- 瑕疵担保責任の期間は適切か" & vbLf
prompt = prompt & "- 工期遅延時のペナルティは妥当か" & vbLf
prompt = prompt & "- 追加工事の取り扱いが明記されているか" & vbLf
prompt = prompt & "- 安全管理責任の所在は明確か" & vbLf

カスタマイズ2：リスクレベルの基準変更

より厳格な評価基準に変更

' ReviewClause関数内のプロンプトを修正
prompt = prompt & "【リスク評価基準】" & vbLf
prompt = prompt & "高リスク: 法的紛争に発展する可能性が高い、または金銭的損失が大きい" & vbLf
prompt = prompt & "中リスク: 解釈の余地があり、将来的にトラブルになる可能性がある" & vbLf
prompt = prompt & "低リスク: 標準的な内容で、特に問題なし" & vbLf

カスタマイズ3：過去契約書との比較（RAG実装）

過去の優良な契約書から類似条項を検索

' 新しい関数を追加
Private Function SearchSimilarClauses(clauseType As String, clauseText As String) As String
    Dim pastContracts As String
    Dim prompt As String
    Dim response As String
    
    ' 過去の契約書データベースを読み込み（Excel別シートに保存されている想定）
    pastContracts = LoadPastContracts(clauseType)
    
    prompt = "以下の契約書の条項について、過去の類似条項と比較し、" & vbLf
    prompt = prompt & "ベストプラクティスを提案してください。" & vbLf & vbLf
    prompt = prompt & "【現在の条項】" & vbLf
    prompt = prompt & clauseText & vbLf & vbLf
    prompt = prompt & "【過去の類似条項】" & vbLf
    prompt = prompt & pastContracts
    
    response = CallOpenAI(prompt, 0.3)
    SearchSimilarClauses = response
End Function

トラブルシューティング

エラー1：Wordが開かない

症状

実行時エラー'429': ActiveXコンポーネントはオブジェクトを作成できません

解決方法

Wordを手動で一度起動して閉じる
VBAから以下のコードを実行

Sub Word終了()

エラー2：APIエラー

症状

[API Error: 401]

解決方法

APIキーを確認
- https://platform.openai.com/api-keys
- 新しいキーを作成
VBAコードに正しく設定されているか確認

エラー3：処理が遅い

症状

10ページの契約書で5分以上かかる

解決方法

モデルを変更

Private Const API_MODEL As String = "gpt-4o-mini"

条項数が多い場合は、重要な条項のみレビュー対象にする

まとめ

実現できたこと

本記事で構築した契約書自動レビューシステムで実現できたこと

項目	従来（人間）	システム導入後
レビュー時間	30分～1時間	1～3分
見落とし	あり	なし（AI が網羅的にチェック）
修正案	経験に依存	常に具体的な修正文を提示
一貫性	担当者により異なる	常に同じ基準で評価
コスト	法務担当者の人件費	API料金（1件10～30円）
利用可能時間	営業時間のみ	24時間いつでも

定量的効果

レビュー時間：30分 → 2分（93%削減）
法務担当者の負荷：大幅軽減
契約書品質：向上

定性的効果

営業部門が自分でチェック可能
法務部門は重要案件に集中できる
見落としリスクの削減
社内の法的リテラシー向上

3部作の総まとめ

記事	レベル	処理対象	実用レベル	主な学び
初級編	1	Excel単一セル	個人学習	API連携の基本
中級編	3	Word 50ファイル	部署レベル	大量処理、独自ルール
上級編	5	契約書レビュー	企業レベル	専門知識、多段階処理、実務応用

今後の発展

このシステムはさらに拡張可能です。

次のステップ

RAG実装：過去の契約書データベースから学習
多言語対応：英文契約書のレビュー
PDFネイティブ対応：PDF契約書の直接処理
承認ワークフロー：Teams/Slackと連携
契約書テンプレート生成：AIで契約書ドラフトを自動作成

応用例

就業規則のチェック
利用規約のレビュー
社内規程の整合性チェック
法改正対応チェック

おわりに

長い記事でしたが、最後までお読みいただきありがとうございました。

契約書レビューという専門性の高い業務を、VBAと生成AIの組み合わせで自動化できることを示しました。

このシステムが、皆さんの業務効率化と法的リスク低減に役立つことを願っています。

参考資料

この記事が役に立ったら、ぜひ LGTM をお願いします

ご質問やフィードバックもお気軽にコメント欄へどうぞ