2023-11-05

【ﾉｰｺｰﾄﾞ】表を比較し、違う行・無い行に色を付ける

2表比較

エクセルVBAマクロを自動作成する無料アプリです。

例として、「表を比較し、無い行・違う行に色を付ける」VBAマクロを作成します。表の形式が異なっても、対応可能です。

事例　相違点に色を付ける
- アプリの設定
- 表示されるVBAコード
ChatGPTで修正
アプリはこちらから↓↓↓↓

事例　相違点に色を付ける

できました😃

なお表の比較は、４つパターンがあります😊

パターンを見る

表を比較し、違う行に色を付ける｜Dictionary

通し番号がある表を比較し、違うセルに色を付ける｜Dictionary

同一の表を比較し、値が違うセルに色を付ける｜配列

表を比較し、違う(同じ)セルに色を付ける｜Dictionary

アプリの設定

アプリへのリンク
　⇒２つの表を比較し、無い行・違う行に色を付ける

表示されるVBAコード

アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。

VBAコードを見る

Sub デモ() '２つの表を比較し、無い行・違う行に色を付ける

Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False ' 警告表示を停止

'辞書オブジェクトの作成
Dim 辞書1 As Object
Set 辞書1 = CreateObject("Scripting.Dictionary")
'基準の表を決定
Sheets("Sheet1").Select
Dim 最終行 As Long, 対象セル As Range
最終行 = Cells(Rows.Count, Range("e3").Column).End(xlUp).Row
Set 対象セル = Range("e3" & ":" & Cells(最終行, Range("g3").Column).Address(False, False))
'辞書1の作成
Dim key1 As Variant, 行1 As Range
For Each 行1 In 対象セル.Rows
key1 = 行1.Cells(1, 1) & "|" & 行1.Cells(1, 2) & "|" & 行1.Cells(1, 3)
If 辞書1.Exists(key1) Then
Else
辞書1(key1) = ""
End If
Next
'色を付ける表を決定
Sheets("Sheet1").Select
Dim 最終行2 As Long
最終行2 = Cells(Rows.Count, Range("a3").Column).End(xlUp).Row
Set 対象セル = Range("a3" & ":" & Cells(最終行2, Range("c3").Column).Address(False, False))
'辞書1にkey2
Dim key2 As Variant, 行2 As Range
For Each 行2 In 対象セル.Rows
key2 = 行2.Cells(1, 1) & "|" & 行2.Cells(1, 2) & "|" & 行2.Cells(1, 3)
'辞書1にkey2が無い
If Not 辞書1.Exists(key2) Then
行2.Interior.Color = RGB(255, 255, 0)
End If
Next
'Application.ScreenUpdatingとApplication.DisplayAlertsをTrueに戻す
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub