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 をお願いします
ご質問やフィードバックもお気軽にコメント欄へどうぞ