【マクロ・VBAダウンロード】異なる日付のセルだけ色を塗る

アイキャッチ画像 エクセル

2つのシートに日付データがあります

Sheet1には処理する日付データがあり、Sheet2には色を塗らないでほしい日付のデータがあります

Sheet1の日付データの中にSheet2にはない日付に関しては、色を塗るという

マクロを組んでみました

コードも載せますので、良かったら使ってみてください

※マクロを入れる場合、EXCELファイルをマクロ形式にしてください

その後、Alt+F11でマクロの画面に移り変わるので、Alt+I+Mを押して

表示した画面にコピペしてください

下の記事にマクロの取り込み方法をまとめたのでよかったら参考にしてください

マクロ(VBA)コード

Sub vba()
'変数//////////////////////////////////
Dim wb As Workbook: Set wb = ThisWorkbook

Dim ws1 As Worksheet: Set ws1 = wb.Sheets("Sheet1") 'Sheet1用変数

Dim ws2 As Worksheet: Set ws2 = wb.Sheets("Sheet2") 'Sheet2用変数

Dim i As Long, j As Long 'カウンター変数

Dim count As Long '同じ日付がある場合のカウント用変数

Dim lastrow_ws1 As Long    'Sheet1の最終行用変数

lastrow_ws1 = ws1.Cells(Rows.count, 1).End(xlUp).Row 'Sheet1の最終行用変数に最終行番号を代入

Dim lastrow_ws2 As Long    'Sheet2の最終行用変数

lastrow_ws2 = ws2.Cells(Rows.count, 1).End(xlUp).Row 'Sheet2の最終行用変数に最終行番号を代入

'Sheet2の条件をSheet1の日付を照合→条件に合う場合色付けする///////
For i = 3 To lastrow_ws1 'Sheet1の3行目から最終行

    For j = 3 To lastrow_ws2 'Sheet2の3行目から最終行
        
        If IsEmpty(ws1.Cells(i, 1)) = True Then 'Sheet1の1列目が空白の時
            
            ws1.Range("A" & i).Interior.Color = vbRed '該当セルを赤く塗る
        
        End If
        
        If ws1.Cells(i, 1) = ws2.Cells(j, 1) Then 'Sheet1とSheet2で同じ日付があるとき
            
            count = 1 'countに1を代入
            
            Exit For 'jのループを抜ける
        
        End If
    
    Next j
    
    If count <> 1 Then 'countが1出ないとき→Sheet1とSheet2で同じ日付がなかった時
        
        ws1.Range("A" & i).Interior.Color = vbRed '該当セルを赤く塗る
    
    End If
    
    count = 0 'countに0を代入して、初期化する

Next i

End Sub

注意

Sheet1,Sheet2のデータはA列であることが条件です

また読み取りの開始位置は3行目から始まりますのでご注意ください

コメント

タイトルとURLをコピーしました