MENU

2つのデータを比較し、無いデータに、色を付ける

無料アプリで、すぐにエクセルVBAマクロを作成できます。

例として、「2つのデータを比較し、”ない”データに、色を付ける」VBAマクロを作成します。

(ページの末尾に、VBAコード掲載)

事例

左のデータに無い、右のデータのセルを、黄色にします。

できました(^^)/

アプリの設定

アプリのトップページ 

 ⇒▼検索・置換・2表比較 

 ⇒2つの異なるデータを比較し、ない(ある)データに、色を付ける

 1列だけでなく、複数列に対応します。

 



表示されるVBAコード 

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

Sub デモ_37() '2つの異なるデータを比較し、ない(ある)データに、色を付ける
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止
'◆◆右下セルの取得
Dim 元右下セル As String, 先右下セル As String
Sheets("Sheet1").Select
'◆最終行を取得し、セル範囲を決める
Range("a4:a4").CurrentRegion.Select
元右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("a4").Column).Address(False, False)
Sheets("sheet1").Select
'◆最終行を取得し、セル範囲を決める
Range("d1:d1").CurrentRegion.Select
先右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("d1").Column).Address(False, False)
'◆◆リスト表から辞書作成
Dim 元シート As Worksheet, 元辞書 As Object, 元key As Variant, 元item As Variant, 元行 As Long
Dim 元左上行 As Long, 元左端列 As Long, 元右端列   As Long, 元右下行 As Long
Set 元辞書 = CreateObject("Scripting.Dictionary")
'初期化
元辞書.RemoveAll
'◆初期値の設定
Set 元シート = Sheets("Sheet1")
元左上行 = 元シート.Range("a4").Row
元左端列 = 元シート.Range("a4").Column
元右下行 = 元シート.Range(元右下セル).Row
元右端列 = 元シート.Range(元右下セル).Column
'◆元表を配列に格納
Dim 元表データ As Variant, 元の列数 As Long, データ1列 As Variant
元表データ = 元シート.Range(Cells(元左上行, 元左端列), Cells(元右下行, 元右端列))
'◆配列を1列づつ、1次元配列へ格納
For 元の列数 = 1 To 元右端列 - 元左端列 + 1
    If 元右端列 = 元左端列 Then
        データ1列 = 元表データ
    Else
        データ1列 = WorksheetFunction.Index(WorksheetFunction.Transpose(元表データ), 元の列数)
    End If
    '元辞書作成
    For Each 元key In データ1列
        If Not 元辞書.Exists(元key) Then
            元辞書.Add 元key, ""
        End If
    Next 元key
Next 元の列数
'◆◆色を付ける処理
Dim 先シート As Worksheet, 先左上行 As Long, 先左端列 As Long, 先右端列  As Long, 先右下行 As Long
Dim 対象列 As Long, 対象行  As Long, 対象key As Variant
'◆初期値の設定
Set 先シート = Sheets("sheet1")
先左上行 = 先シート.Range("d1").Row
先左端列 = 先シート.Range("d1").Column
先右下行 = 先シート.Range(先右下セル).Row
先右端列 = 先シート.Range(先右下セル).Column
先シート.Range(Range("d1") & ":" & Range(先右下セル)).Interior.ColorIndex = xlNone
For 対象列 = 先左端列 To 先右端列
    For 対象行 = 先左上行 To 先右下行
        対象key = 先シート.Cells(対象行, 対象列).Value
        If Not 元辞書.Exists(対象key) Then
            Cells(対象行, 対象列).Interior.Color = RGB(255, 255, 0)
        End If
    Next 対象行
Next 対象列
Application.DisplayAlerts = True   ' 警告表示を再開
Application.ScreenUpdating = True  ' 画面描画を再開
End Sub

マクロを使うメリット

手作業で数分かかる作業が、1秒で終わります。

ぜひ、アプリをご利用ください。

 

アプリはこちらから↓↓↓↓