本ブログの500本記念記事として、
私のコーディングガイドランを以下のページにまとめました。
よろしければご一読いただき、皆さんのマイルール作りの参考にしてみてください。
さてこのコーディングガイドライン
AIに読ませたらどこまで順守してコードを書くのか気になるところです。
ChatGPT、Claude、Copilot、Geminiの4AIにマクロを作ってもらいましたので、
コーディング規約を用いたコード生成の参考にしてもらえれば幸いです。
作成マクロとプロンプト
「二つのシートの差分をとるマクロ」を作ってもらいます。
値だけなく、書式や図形などにも差分を作った以下の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つのシートの差異を検出する '------------------------------------------ Sub ★2つのシートの差異を検出する() 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 ' ======================================== ' 実行モジュール ' ======================================== Sub ★2つのシートを比較して差異を出力する() ' 選択の実施 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