和風スパゲティのレシピ

日本語でコーディングするExcelVBA

コーディング規約を活用した生成AIコーディング

本ブログの500本記念記事として、
私のコーディングガイドランを以下のページにまとめました。

よろしければご一読いただき、皆さんのマイルール作りの参考にしてみてください。


さてこのコーディングガイドライン
AIに読ませたらどこまで順守してコードを書くのか気になるところです。

ChatGPTClaudeCopilotGeminiの4AIにマクロを作ってもらいましたので、
コーディング規約を用いたコード生成の参考にしてもらえれば幸いです。

作成マクロとプロンプト

「二つのシートの差分をとるマクロ」を作ってもらいます。

値だけなく、書式や図形などにも差分を作った以下の2シートでテストします。

差分をチェックする2シート


このマクロは「第1回 AIサービス別VBAコード生成比較大会」のお題でした。

コーディング規約なしでの生成コードを以下の記事にまとめていますので、
よろしければこちらの記事もご覧ください。


プロンプトは以下の2種類で試しました。

2つのシートの違いの検出するマクロを作ってください。
値だけでなく書式や図形などの違いも検出して下さい。
マクロは以下のコーディング規約にのっとって書いてください。
https://www.limecode.jp/entry/guideline/excelvba-coding-guidelines

2つのシートの違いの検出するマクロを作ってください。
値だけでなく書式や図形などの違いも検出して下さい。
マクロは添付のコーディング規約にのっとって書いてください。

 
要は「URLを渡した版」「PDFを渡した版」の比較となります。

総評

「文書を読ませる場合はPDFにして渡すと精度よく読み込んでくれる」
という話を聞いてこのプロンプトにしたのですが、噂にたがわぬ性能でした。


PDFを渡したプロンプトでは4AIともかなり読みやすいコードを生成してくれ、
中身もコーディング規約なしで作ったコードよりかなり精度が高いもの
でした。

シンプルで読みやすかったChatGPTのコードと、
もっとも高性能でプロシージャ構成も綺麗だったClaudeのコードの、
二つのソースコードをページ下部に置いておきますのでご覧ください。


変数の命名規則が完全に私だったのもかなりありがたいポイントでしたし、
全AIが「Key:シェイプ名 Item:シェイプ本体を格納したDictionary」という、
私が作るならそうしたであろう設計でロジックを組んでくれたのは感動しました。

ただPDFを渡して簡単なプロンプトを渡すだけでこのレベルのコードを生成してくれるので、これは活用しない手はないんじゃないかと思います。


AIの生成コード特有のバグの多さやロジックの抜け漏れはまだまだあるのですが、
設計や変数の命名を自分の普段のコードにかなり寄せてくれているため、
コードを読むのが苦痛ではなく、デバッグや微調整がかなりやりやすかったです。


使用したPDFをこちらにも添付しておきますので、
これを使って和風スパゲティ2号を部下として使ってみていただければと思います。

【和風スパ】ExcelVBAコーディングガイドライン.PDF(DLリンク)


対してURLを渡したバージョンですが、そもそも生成AIの特徴として、

  • 渡したURL以外のページもブラウジングする
  • どの程度ブラウジングするかはプロンプトやAIによる

という性質があるようです。


一番良かったのはClaudeで、サイト内の別ページにある汎用関数を用いてくれたり、
全体的により自分のコードに似せた設計になっている気がしました。

対して一番悪かったのはChatGPTで、なんと変数名を英語にしてきました。

お前はどこで何を読んだのだ。


といいつつChatGPTに全く同じプロンプトを再度試させると、
普通に規約に則ったコードを書いてくるときもあり、時と場合によるようです。

このあたりは「ブラウジング設定」や「思考モード」でも制御できるようなので、
使いこなせる方は和風スパゲティのレシピ全体をブラウジングし、
和風スパゲティ3号を部下にしてみてもいいかもしれません。


ただ安定性は欠きますし、肝心のガイドラインを読み込まない可能性もあるため、
個人的にはPDFによるコーディングの方がノイズが少なくてよさそうに思いました。


ただしPDFは「添付ファイル制限」を消費するため、
無料版をお使いの方や画像生成をよく行う方には向かないかもしれません。


その場合は、こちらの記事(再掲)の全文をコピーして渡すことで、
ほぼPDFと同じような性能のコーディングを行わせることができるようです。

添付ファイル制限より文字数(トークン数)制限の方がはるかに緩いため、
無料版の方は「記事の全文貼り付け」を利用してみてください。

ソースコード

  • シンプルで読みやすかった「PDFを読み込んだChatGPTのコード」
  • 高性能だった「URLからサイト全体をブラウズしたClaudeのコード」

を置いておきますのでご覧ください。


なお、今回は一発生成で修正は行っていないため、
コンパイルも通らないコードのままになっています。

実行はできませんので、コードの全体像を流し見してみてください。


AI4種 × PDF/URL の計8コードをすべて見たい方は、
以下のファイルに搭載しましたのでダウンロードしてご閲覧ください。
ガイドライン活用AI生成ソースコード.xlsm(DLリンク)

ChatGPT(PDF版)

Option Explicit

'------------------------------------------
'★選択した2つのシートの差異を検出する
'------------------------------------------
Sub2つのシートの差異を検出する()
    Dim ws比較元 As Worksheet
    Dim ws比較先 As Worksheet
    Dim ws結果 As Worksheet

    ' 比較対象を指定
    Set ws比較元 = ThisWorkbook.Worksheets("Sheet1")
    Set ws比較先 = ThisWorkbook.Worksheets("Sheet2")

    ' 結果シートを新規作成
    Set ws結果 = ThisWorkbook.Worksheets.Add
    ws結果.Name = "比較結果"
    ws結果.Range("A1:E1").Value = Array("種類", "セル位置/オブジェクト名", "比較元", "比較先", "差異内容")

    Call シートの差異を比較する(ws比較元, ws比較先, ws結果)
    Call 図形の差異を比較する(ws比較元, ws比較先, ws結果)

    MsgBox "比較が完了しました。", vbInformation

End Sub

'------------------------------------------
'シート上のセル内容・書式の差異を比較する
'------------------------------------------
Private Sub シートの差異を比較する(ByVal ws1 As Worksheet, ByVal ws2 As Worksheet, ByRef ws結果 As Worksheet)
    Dim R As Long, C As Long
    Dim 最終行 As Long, 最終列 As Long
    Dim cell1 As Range, cell2 As Range
    Dim 比較行 As Long

    最終行 = Application.Max(ws1.UsedRange.Rows.Count, ws2.UsedRange.Rows.Count)
    最終列 = Application.Max(ws1.UsedRange.Columns.Count, ws2.UsedRange.Columns.Count)
    比較行 = 2

    For R = 1 To 最終行
        For C = 1 To 最終列
            Set cell1 = ws1.Cells(R, C)
            Set cell2 = ws2.Cells(R, C)

            ' 値の差異
            If cell1.Value <> cell2.Value Then
                ws結果.Cells(比較行, 1) = "値"
                ws結果.Cells(比較行, 2) = cell1.Address(False, False)
                ws結果.Cells(比較行, 3) = cell1.Value
                ws結果.Cells(比較行, 4) = cell2.Value
                ws結果.Cells(比較行, 5) = "値が異なります"
                比較行 = 比較行 + 1
            End If

            ' 背景色の差異
            If cell1.Interior.Color <> cell2.Interior.Color Then
                ws結果.Cells(比較行, 1) = "書式(背景色)"
                ws結果.Cells(比較行, 2) = cell1.Address(False, False)
                ws結果.Cells(比較行, 3) = cell1.Interior.Color
                ws結果.Cells(比較行, 4) = cell2.Interior.Color
                ws結果.Cells(比較行, 5) = "背景色が異なります"
                比較行 = 比較行 + 1
            End If

            ' フォント色の差異
            If cell1.Font.Color <> cell2.Font.Color Then
                ws結果.Cells(比較行, 1) = "書式(フォント色)"
                ws結果.Cells(比較行, 2) = cell1.Address(False, False)
                ws結果.Cells(比較行, 3) = cell1.Font.Color
                ws結果.Cells(比較行, 4) = cell2.Font.Color
                ws結果.Cells(比較行, 5) = "フォント色が異なります"
                比較行 = 比較行 + 1
            End If

            ' フォント名・サイズ
            If cell1.Font.Name <> cell2.Font.Name Or cell1.Font.Size <> cell2.Font.Size Then
                ws結果.Cells(比較行, 1) = "書式(フォント)"
                ws結果.Cells(比較行, 2) = cell1.Address(False, False)
                ws結果.Cells(比較行, 3) = cell1.Font.Name & " / " & cell1.Font.Size
                ws結果.Cells(比較行, 4) = cell2.Font.Name & " / " & cell2.Font.Size
                ws結果.Cells(比較行, 5) = "フォント設定が異なります"
                比較行 = 比較行 + 1
            End If

        Next C
    Next R

End Sub

'------------------------------------------
'図形(Shapes)の差異を比較する
'------------------------------------------
Private Sub 図形の差異を比較する(ByVal ws1 As Worksheet, ByVal ws2 As Worksheet, ByRef ws結果 As Worksheet)
    Dim shp1 As Shape
    Dim shp2 As Shape
    Dim 比較行 As Long
    比較行 = ws結果.Cells(ws結果.Rows.Count, 1).End(xlUp).Row + 1

    Dim Dic形状1 As Object
    Dim Dic形状2 As Object
    Set Dic形状1 = CreateObject("Scripting.Dictionary")
    Set Dic形状2 = CreateObject("Scripting.Dictionary")

    ' シート1の図形一覧
    For Each shp1 In ws1.Shapes
        Dic形状1(shp1.Name) = shp1
    Next

    ' シート2の図形一覧
    For Each shp2 In ws2.Shapes
        Dic形状2(shp2.Name) = shp2
    Next

    ' 図形名の比較
    Dim key As Variant
    For Each key In Dic形状1.Keys
        If Not Dic形状2.Exists(key) Then
            ws結果.Cells(比較行, 1) = "図形"
            ws結果.Cells(比較行, 2) = key
            ws結果.Cells(比較行, 3) = "あり"
            ws結果.Cells(比較行, 4) = "なし"
            ws結果.Cells(比較行, 5) = "図形が存在しません"
            比較行 = 比較行 + 1
        Else
            ' 位置・サイズ・塗り色の比較
            Set shp1 = Dic形状1(key)
            Set shp2 = Dic形状2(key)

            If shp1.Left <> shp2.Left Or shp1.Top <> shp2.Top Or shp1.Width <> shp2.Width Or shp1.Height <> shp2.Height Then
                ws結果.Cells(比較行, 1) = "図形(位置/サイズ)"
                ws結果.Cells(比較行, 2) = key
                ws結果.Cells(比較行, 3) = shp1.Left & "," & shp1.Top & "," & shp1.Width & "," & shp1.Height
                ws結果.Cells(比較行, 4) = shp2.Left & "," & shp2.Top & "," & shp2.Width & "," & shp2.Height
                ws結果.Cells(比較行, 5) = "図形位置またはサイズが異なります"
                比較行 = 比較行 + 1
            End If

            If shp1.Fill.ForeColor.RGB <> shp2.Fill.ForeColor.RGB Then
                ws結果.Cells(比較行, 1) = "図形(塗り色)"
                ws結果.Cells(比較行, 2) = key
                ws結果.Cells(比較行, 3) = shp1.Fill.ForeColor.RGB
                ws結果.Cells(比較行, 4) = shp2.Fill.ForeColor.RGB
                ws結果.Cells(比較行, 5) = "図形の色が異なります"
                比較行 = 比較行 + 1
            End If
        End If
    Next

    ' シート2にしかない図形
    For Each key In Dic形状2.Keys
        If Not Dic形状1.Exists(key) Then
            ws結果.Cells(比較行, 1) = "図形"
            ws結果.Cells(比較行, 2) = key
            ws結果.Cells(比較行, 3) = "なし"
            ws結果.Cells(比較行, 4) = "あり"
            ws結果.Cells(比較行, 5) = "比較先のみ存在"
            比較行 = 比較行 + 1
        End If
    Next

End Sub

Claude(URL)

Option Explicit

' ========================================
' 実行モジュール
' ========================================

Sub2つのシートを比較して差異を出力する()
    ' 選択の実施
    Dim ws比較元 As Worksheet
    Dim ws比較先 As Worksheet

    On Error Resume Next
    Set ws比較元 = Application.InputBox("比較元のシートを選択してください", Type:=8)
    If ws比較元 Is Nothing Then Exit Sub

    Set ws比較先 = Application.InputBox("比較先のシートを選択してください", Type:=8)
    If ws比較先 Is Nothing Then Exit Sub
    On Error GoTo 0

    If ws比較元.Name = ws比較先.Name Then
        MsgBox "同じシートが選択されています。", vbExclamation
        Exit Sub
    End If

    ' 自動更新を停止
    Call Excelの自動更新を停止する

    ' メイン処理の実行
    Dim ws結果 As Worksheet
    Set ws結果 = 二つのシートを比較して差異を出力する(ws比較元, ws比較先)

    ' 自動更新を再開
    Call Excelの自動更新を再開する

    ' 完了メッセージ
    MsgBox "比較が完了しました。" & vbCrLf & _
           "結果シート: " & ws結果.Name, vbInformation

    ws結果.Activate
End Sub


' ========================================
' メインコードモジュール
' ========================================

Function 二つのシートを比較して差異を出力する( _
    ws比較元 As Worksheet, _
    ws比較先 As Worksheet) As Worksheet

    ' 結果シートの作成
    Dim ws結果 As Worksheet
    Set ws結果 = 結果シートを作成する(ws比較元, ws比較先)

    ' データ範囲の取得
    Dim RLast比較元 As Long: RLast比較元 = Get最終行(ws比較元)
    Dim CLast比較元 As Long: CLast比較元 = Get最終列(ws比較元)
    Dim RLast比較先 As Long: RLast比較先 = Get最終行(ws比較先)
    Dim CLast比較先 As Long: CLast比較先 = Get最終列(ws比較先)

    Dim RLast As Long: RLast = Application.WorksheetFunction.Max(RLast比較元, RLast比較先)
    Dim CLast As Long: CLast = Application.WorksheetFunction.Max(CLast比較元, CLast比較先)

    ' セル値・書式の比較
    Call セル値と書式の差異を記録する(ws比較元, ws比較先, ws結果, RLast, CLast)

    ' 図形の比較
    Call 図形の差異を記録する(ws比較元, ws比較先, ws結果)

    ' セルの幅・高さの比較
    Call セル幅と高さの差異を記録する(ws比較元, ws比較先, ws結果, RLast, CLast)

    ' シート設定の比較
    Call シート設定の差異を記録する(ws比較元, ws比較先, ws結果)

    ' 結果の整形
    Call 結果シートを整形する(ws結果)

    Set 二つのシートを比較して差異を出力する = ws結果
End Function


' ========================================
' サブプロシージャ群
' ========================================

Private Function 結果シートを作成する( _
    ws比較元 As Worksheet, _
    ws比較先 As Worksheet) As Worksheet

    Dim ws As Worksheet
    Set ws = ws比較元.Parent.Worksheets.Add
    ws.Name = "比較結果_" & Format(Now, "yyyymmdd_hhnnss")

    ' ヘッダーの設定
    With ws
        .Range("A1").Value = "差異の種類"
        .Range("B1").Value = "位置・項目"
        .Range("C1").Value = "比較元の値"
        .Range("D1").Value = "比較先の値"
        .Range("E1").Value = "詳細"

        .Range("A1:E1").Font.Bold = True
        .Range("A1:E1").Interior.Color = RGB(200, 200, 200)
    End With

    Set 結果シートを作成する = ws
End Function

Private Sub セル値と書式の差異を記録する( _
    ws比較元 As Worksheet, _
    ws比較先 As Worksheet, _
    ws結果 As Worksheet, _
    RLast As Long, _
    CLast As Long)

    Dim R_ As Long
    Dim C_ As Long
    Dim R結果 As Long: R結果 = 2

    For R_ = 1 To RLast
        For C_ = 1 To CLast
            Dim cell比較元 As Range
            Dim cell比較先 As Range

            Set cell比較元 = ws比較元.Cells(R_, C_)
            Set cell比較先 = ws比較先.Cells(R_, C_)

            Dim セル位置 As String
            セル位置 = cell比較元.Address(False, False)

            ' セル値の比較
            If cell比較元.Value <> cell比較先.Value Then
                Call 差異を記録する(ws結果, R結果, "セル値", セル位置, _
                    cell比較元.Value, cell比較先.Value, "")
                R結果 = R結果 + 1
            End If

            ' 背景色の比較
            If cell比較元.Interior.Color <> cell比較先.Interior.Color Then
                Call 差異を記録する(ws結果, R結果, "背景色", セル位置, _
                    cell比較元.Interior.Color, cell比較先.Interior.Color, _
                    "元:" & Get色名(cell比較元.Interior.Color) & " / 先:" & Get色名(cell比較先.Interior.Color))
                R結果 = R結果 + 1
            End If

            ' フォント色の比較
            If cell比較元.Font.Color <> cell比較先.Font.Color Then
                Call 差異を記録する(ws結果, R結果, "フォント色", セル位置, _
                    cell比較元.Font.Color, cell比較先.Font.Color, _
                    "元:" & Get色名(cell比較元.Font.Color) & " / 先:" & Get色名(cell比較先.Font.Color))
                R結果 = R結果 + 1
            End If

            ' フォントサイズの比較
            If cell比較元.Font.Size <> cell比較先.Font.Size Then
                Call 差異を記録する(ws結果, R結果, "フォントサイズ", セル位置, _
                    cell比較元.Font.Size, cell比較先.Font.Size, "")
                R結果 = R結果 + 1
            End If

            ' 太字の比較
            If cell比較元.Font.Bold <> cell比較先.Font.Bold Then
                Call 差異を記録する(ws結果, R結果, "太字", セル位置, _
                    cell比較元.Font.Bold, cell比較先.Font.Bold, "")
                R結果 = R結果 + 1
            End If

            ' 斜体の比較
            If cell比較元.Font.Italic <> cell比較先.Font.Italic Then
                Call 差異を記録する(ws結果, R結果, "斜体", セル位置, _
                    cell比較元.Font.Italic, cell比較先.Font.Italic, "")
                R結果 = R結果 + 1
            End If

            ' 下線の比較
            If cell比較元.Font.Underline <> cell比較先.Font.Underline Then
                Call 差異を記録する(ws結果, R結果, "下線", セル位置, _
                    Get下線種類(cell比較元.Font.Underline), _
                    Get下線種類(cell比較先.Font.Underline), "")
                R結果 = R結果 + 1
            End If

            ' 罫線の比較(上下左右)
            Call 罫線の差異を記録する(cell比較元, cell比較先, ws結果, R結果, セル位置)

            ' 表示形式の比較
            If cell比較元.NumberFormatLocal <> cell比較先.NumberFormatLocal Then
                Call 差異を記録する(ws結果, R結果, "表示形式", セル位置, _
                    cell比較元.NumberFormatLocal, cell比較先.NumberFormatLocal, "")
                R結果 = R結果 + 1
            End If

            ' 配置の比較
            If cell比較元.HorizontalAlignment <> cell比較先.HorizontalAlignment Then
                Call 差異を記録する(ws結果, R結果, "水平配置", セル位置, _
                    Get配置名(cell比較元.HorizontalAlignment), _
                    Get配置名(cell比較先.HorizontalAlignment), "")
                R結果 = R結果 + 1
            End If

            If cell比較元.VerticalAlignment <> cell比較先.VerticalAlignment Then
                Call 差異を記録する(ws結果, R結果, "垂直配置", セル位置, _
                    Get配置名(cell比較元.VerticalAlignment), _
                    Get配置名(cell比較先.VerticalAlignment), "")
                R結果 = R結果 + 1
            End If
        Next
    Next
End Sub

Private Sub 罫線の差異を記録する( _
    cell比較元 As Range, _
    cell比較先 As Range, _
    ws結果 As Worksheet, _
    ByRef R結果 As Long, _
    セル位置 As String)

    Dim 罫線位置 As Variant
    Dim 罫線種類(1 To 4) As Long
    罫線種類(1) = xlEdgeTop
    罫線種類(2) = xlEdgeBottom
    罫線種類(3) = xlEdgeLeft
    罫線種類(4) = xlEdgeRight

    Dim 罫線名(1 To 4) As String
    罫線名(1) = "上"
    罫線名(2) = "下"
    罫線名(3) = "左"
    罫線名(4) = "右"

    Dim i As Long
    For i = 1 To 4
        Dim 元線種 As Long: 元線種 = cell比較元.Borders(罫線種類(i)).LineStyle
        Dim 先線種 As Long: 先線種 = cell比較先.Borders(罫線種類(i)).LineStyle

        If 元線種 <> 先線種 Then
            Call 差異を記録する(ws結果, R結果, "罫線_" & 罫線名(i), セル位置, _
                Get罫線種類(元線種), Get罫線種類(先線種), "")
            R結果 = R結果 + 1
        End If
    Next
End Sub

Private Sub 図形の差異を記録する( _
    ws比較元 As Worksheet, _
    ws比較先 As Worksheet, _
    ws結果 As Worksheet)

    Dim R結果 As Long: R結果 = Get最終行(ws結果) + 1

    ' 図形数の記録
    Dim 元図形数 As Long: 元図形数 = ws比較元.Shapes.Count
    Dim 先図形数 As Long: 先図形数 = ws比較先.Shapes.Count

    If 元図形数 <> 先図形数 Then
        Call 差異を記録する(ws結果, R結果, "図形数", "シート全体", _
            元図形数, 先図形数, "")
        R結果 = R結果 + 1
    End If

    ' 各図形の比較
    Dim Dic図形 As Object
    Set Dic図形 = CreateObject("Scripting.Dictionary")

    Dim shp As Shape
    For Each shp In ws比較元.Shapes
        Dic図形(shp.Name) = "比較元"
    Next

    For Each shp In ws比較先.Shapes
        If Dic図形.Exists(shp.Name) Then
            Dic図形(shp.Name) = "両方"
        Else
            Dic図形(shp.Name) = "比較先"
        End If
    Next

    ' 存在しない図形の記録
    Dim key As Variant
    For Each key In Dic図形.Keys
        If Dic図形(key) = "比較元" Then
            Call 差異を記録する(ws結果, R結果, "図形", key, "存在する", "存在しない", "")
            R結果 = R結果 + 1
        ElseIf Dic図形(key) = "比較先" Then
            Call 差異を記録する(ws結果, R結果, "図形", key, "存在しない", "存在する", "")
            R結果 = R結果 + 1
        Else
            ' 両方に存在する場合は位置とサイズを比較
            Dim shp元 As Shape
            Dim shp先 As Shape
            Set shp元 = ws比較元.Shapes(CStr(key))
            Set shp先 = ws比較先.Shapes(CStr(key))

            If Abs(shp元.Left - shp先.Left) > 0.1 Or Abs(shp元.Top - shp先.Top) > 0.1 Then
                Call 差異を記録する(ws結果, R結果, "図形位置", key, _
                    "Left:" & Round(shp元.Left, 1) & " Top:" & Round(shp元.Top, 1), _
                    "Left:" & Round(shp先.Left, 1) & " Top:" & Round(shp先.Top, 1), "")
                R結果 = R結果 + 1
            End If

            If Abs(shp元.Width - shp先.Width) > 0.1 Or Abs(shp元.Height - shp先.Height) > 0.1 Then
                Call 差異を記録する(ws結果, R結果, "図形サイズ", key, _
                    "W:" & Round(shp元.Width, 1) & " H:" & Round(shp元.Height, 1), _
                    "W:" & Round(shp先.Width, 1) & " H:" & Round(shp先.Height, 1), "")
                R結果 = R結果 + 1
            End If
        End If
    Next
End Sub

Private Sub セル幅と高さの差異を記録する( _
    ws比較元 As Worksheet, _
    ws比較先 As Worksheet, _
    ws結果 As Worksheet, _
    RLast As Long, _
    CLast As Long)

    Dim R結果 As Long: R結果 = Get最終行(ws結果) + 1

    ' 列幅の比較
    Dim C_ As Long
    For C_ = 1 To CLast
        Dim 元幅 As Double: 元幅 = ws比較元.Columns(C_).ColumnWidth
        Dim 先幅 As Double: 先幅 = ws比較先.Columns(C_).ColumnWidth

        If Abs(元幅 - 先幅) > 0.01 Then
            Call 差異を記録する(ws結果, R結果, "列幅", _
                ws比較元.Cells(1, C_).Address(False, False, xlA1, False), _
                元幅, 先幅, "")
            R結果 = R結果 + 1
        End If
    Next

    ' 行高の比較
    Dim R_ As Long
    For R_ = 1 To RLast
        Dim 元高 As Double: 元高 = ws比較元.Rows(R_).RowHeight
        Dim 先高 As Double: 先高 = ws比較先.Rows(R_).RowHeight

        If Abs(元高 - 先高) > 0.01 Then
            Call 差異を記録する(ws結果, R結果, "行高", _
                ws比較元.Cells(R_, 1).Address(False, False, xlA1, False), _
                元高, 先高, "")
            R結果 = R結果 + 1
        End If
    Next
End Sub

Private Sub シート設定の差異を記録する( _
    ws比較元 As Worksheet, _
    ws比較先 As Worksheet, _
    ws結果 As Worksheet)

    Dim R結果 As Long: R結果 = Get最終行(ws結果) + 1

    ' シート名
    If ws比較元.Name <> ws比較先.Name Then
        Call 差異を記録する(ws結果, R結果, "シート名", "シート設定", _
            ws比較元.Name, ws比較先.Name, "")
        R結果 = R結果 + 1
    End If

    ' 見出し固定
    If ws比較元.FreezePanes <> ws比較先.FreezePanes Then
        Call 差異を記録する(ws結果, R結果, "ウィンドウ枠固定", "シート設定", _
            ws比較元.FreezePanes, ws比較先.FreezePanes, "")
        R結果 = R結果 + 1
    End If

    ' 表示倍率
    If ws比較元.Parent.Windows(1).Zoom <> ws比較先.Parent.Windows(1).Zoom Then
        Call 差異を記録する(ws結果, R結果, "表示倍率", "シート設定", _
            ws比較元.Parent.Windows(1).Zoom, ws比較先.Parent.Windows(1).Zoom, "")
        R結果 = R結果 + 1
    End If

    ' グリッド線
    On Error Resume Next
    Dim 元グリッド As Boolean: 元グリッド = ws比較元.Parent.Windows(1).DisplayGridlines
    Dim 先グリッド As Boolean: 先グリッド = ws比較先.Parent.Windows(1).DisplayGridlines
    On Error GoTo 0

    If 元グリッド <> 先グリッド Then
        Call 差異を記録する(ws結果, R結果, "グリッド線表示", "シート設定", _
            元グリッド, 先グリッド, "")
        R結果 = R結果 + 1
    End If
End Sub

Private Sub 差異を記録する( _
    ws結果 As Worksheet, _
    R結果 As Long, _
    差異種類 As String, _
    位置 As String, _
    元値 As Variant, _
    先値 As Variant, _
    詳細 As String)

    With ws結果
        .Cells(R結果, 1).Value = 差異種類
        .Cells(R結果, 2).Value = 位置
        .Cells(R結果, 3).Value = 元値
        .Cells(R結果, 4).Value = 先値
        .Cells(R結果, 5).Value = 詳細
    End With
End Sub

Private Sub 結果シートを整形する(ws結果 As Worksheet)
    With ws結果
        ' 列幅の自動調整
        .Columns("A:E").AutoFit

        ' フィルターの設定
        If .AutoFilterMode = False Then
            .Range("A1").AutoFilter
        End If

        ' 差異がない場合のメッセージ
        If Get最終行(ws結果) = 1 Then
            .Range("A2").Value = "差異なし"
            .Range("A2:E2").Merge
            .Range("A2").HorizontalAlignment = xlCenter
            .Range("A2").Font.Bold = True
            .Range("A2").Interior.Color = RGB(220, 255, 220)
        End If
    End With
End Sub


' ========================================
' ライブラリ関数
' ========================================

Private Function Get最終行(ws As Worksheet, Optional C_ As Long = 1) As Long
    Get最終行 = ws.Cells(ws.Rows.Count, C_).End(xlUp).Row
End Function

Private Function Get最終列(ws As Worksheet, Optional R_ As Long = 1) As Long
    Get最終列 = ws.Cells(R_, ws.Columns.Count).End(xlToLeft).Column
End Function

Private Function Get色名(色コード As Long) As String
    Select Case 色コード
        Case RGB(255, 255, 255): Get色名 = "白"
        Case RGB(0, 0, 0): Get色名 = "黒"
        Case RGB(255, 0, 0): Get色名 = "赤"
        Case RGB(0, 255, 0): Get色名 = "緑"
        Case RGB(0, 0, 255): Get色名 = "青"
        Case RGB(255, 255, 0): Get色名 = "黄"
        Case Else: Get色名 = "RGB(" & (色コード Mod 256) & "," & ((色コード \ 256) Mod 256) & "," & (色コード \ 65536) & ")"
    End Select
End Function

Private Function Get罫線種類(線種 As Long) As String
    Select Case 線種
        Case xlLineStyleNone: Get罫線種類 = "なし"
        Case xlContinuous: Get罫線種類 = "実線"
        Case xlDash: Get罫線種類 = "破線"
        Case xlDot: Get罫線種類 = "点線"
        Case xlDashDot: Get罫線種類 = "一点鎖線"
        Case xlDashDotDot: Get罫線種類 = "二点鎖線"
        Case Else: Get罫線種類 = "不明(" & 線種 & ")"
    End Select
End Function

Private Function Get下線種類(下線 As Long) As String
    Select Case 下線
        Case xlUnderlineStyleNone: Get下線種類 = "なし"
        Case xlUnderlineStyleSingle: Get下線種類 = "一重線"
        Case xlUnderlineStyleDouble: Get下線種類 = "二重線"
        Case Else: Get下線種類 = "不明(" & 下線 & ")"
    End Select
End Function

Private Function Get配置名(配置 As Long) As String
    Select Case 配置
        Case xlLeft: Get配置名 = "左揃え"
        Case xlCenter: Get配置名 = "中央揃え"
        Case xlRight: Get配置名 = "右揃え"
        Case xlTop: Get配置名 = "上揃え"
        Case xlBottom: Get配置名 = "下揃え"
        Case xlGeneral: Get配置名 = "標準"
        Case Else: Get配置名 = "不明(" & 配置 & ")"
    End Select
End Function

Private Sub Excelの自動更新を停止する()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
End Sub

Private Sub Excelの自動更新を再開する()
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub