| 
    
     |  | ▼dai さん: 
 >MaxはAL列まででした。
 >A列の氏名は固定です。
 >B列からすべて列をチェックしたいです。
 
 列数が変動する場合です
 
 Sub Lookup3()
 Dim dic As Object
 Dim i As Long, j As Long, jz As Long
 Dim ok As Boolean
 Dim v
 
 '---- Sheet1 A列を辞書にキー登録
 With Worksheets(1)
 v = .Range("A2", .Cells(1).End(xlDown)).Value
 End With
 Set dic = CreateObject("Scripting.Dictionary")
 For i = 1 To UBound(v)
 dic(v(i, 1)) = Empty
 Next
 
 '---- Sheet2のB列またはD列が 辞書にあれば セルを色塗り
 With Worksheets(2)
 .UsedRange.Interior.ColorIndex = xlNone
 v = .Cells(1).CurrentRegion.Value
 jz = UBound(v, 2)   '最終列番号
 For i = 2 To UBound(v) '2行目から
 ok = False
 For j = 2 To jz 'B列からチェックはじめ
 If dic.Exists(v(i, j)) Then
 If Not ok Then
 .Cells(i, 1).Interior.Color = vbRed 'A列
 ok = True
 End If
 .Cells(i, j).Interior.Color = vbRed
 End If
 Next
 Next
 End With
 End Sub
 
 |  |