【マクロ・VBA　コード・ファイルダウンロード可】セルの値が同じ時色付けするマクロ

Sub 色塗り()
'変数////////////////////////////////////
Dim wb As Workbook: Set wb = ThisWorkbook

Dim ws As Worksheet: Set ws = wb.Sheets("色付け")

Dim last_r, last_r1 '最終行の取得

Dim last_col '最終列の取得

Dim name '色を塗るセルの名前

Dim color_num '色のシリアルナンバー

Dim i, j, k, c 'カウンター変数

'重複の確認/////////////////////////////
last_r = ws.Cells(Rows.Count, 1).End(xlUp).Row '色を塗りたいA列最終行の取得

For i = 6 To last_r - 1 '6行目から最終行の1つ前まで
    
    For j = i + 1 To last_r '7行目から最終行まで
    
        With ws
        
        If .Cells(i, 1) = .Cells(j, 1) Then '重複があるとき
            
            .Range("A" & i).Interior.ColorIndex = 0 '色を抜く
            
            .Range("A" & j).Interior.ColorIndex = 0 '色を抜く
            
            c = 1
        
        End If
        
        End With
        
    
    Next j

Next i

If c = 1 Then '重複があったとき

    MsgBox "重複があります" & vbCrLf & vbCrLf & "重複箇所の色を抜いたので重複箇所を削除してください"
    
    Exit Sub 'マクロ強制終了
    
End If


'指定のセルに色を塗る//////////////////
last_r1 = ws.Range("C1").CurrentRegion.Rows.Count '色を塗りたい表の最終行

last_col = ws.Range("C1").CurrentRegion.Columns.Count + 2   '色を塗りたい表の最終列


For i = 6 To last_r
    
    name = ws.Cells(i, 1) '色を塗るセルを代入
    
    color_num = ws.Range("A" & i).Interior.ColorIndex '塗る色のシリアルナンバーを代入
    
    For j = 1 To last_r1
        
        For k = 3 To last_col
        
            If name = ws.Cells(j, k) Then '色を塗りたいセルと表のセルが同じとき
            
                ws.Cells(j, k).Interior.ColorIndex = color_num '指定した色を塗る
                
            End If
        
        Next k
    
    Next j
    
Next i

End Sub

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

Dim ws As Worksheet: Set ws = wb.Sheets("色付け")

'削除//////////////////////////////////
ws.Range("C1").CurrentRegion.Clear

End Sub