1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
| Option Explicit
Public Sub test()
Dim rgBase As Range
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim resultVlookup As Variant
Dim testCode As Boolean
Dim testHeader As Boolean
Dim prog As String
Dim header As String
Dim code As String
Set rgBase = Worksheets("PROG_TAB").Range("A2:C100") 'A adapter
Set ws = Worksheets("Feuil1")
lastRow = ws.Range("E65536").End(xlUp).Row
For i = 2 To lastRow
'On enlève la couleur pour la cellule en E
ws.Cells(i, "E").Interior.ColorIndex = xlNone
'On récupère les valeurs pour la ligne
prog = ws.Cells(i, "A").Value
header = ws.Cells(i, "D").Value
code = ws.Cells(i, "E").Value
If code <> "" Then 'La cellule n'est pas vide
testCode = True 'On la passera à false en case de non respect d'un test
testHeader = True
'On cherche si prog est dans la base et le code correspondant
resultVlookup = WorksheetFunction.VLookup(prog, rgBase, 3, False)
If IsError(resultVlookup) Then 'Il n'est pas dans la base
testCode = False
testHeader = False
Else 'Il est dans la base
If resultVlookup <> code Then 'Le code ne correspond pas
testCode = False
Else 'Le code correspond
'On teste le header
resultVlookup = WorksheetFunction.VLookup(prog, rgBase, 2, False)
'Plus besoin de faire de iserror cette fois, on est sûr que ça existe
If resultVlookup <> header Then testHeader = False 'Le header ne correspond pas
End If
End If
If (Not testCode) Or (Not testHeader) Then
If Not testHeader Then
ws.Cells(i, "E").Interior.Color = RGB(255, 0, 0) 'Si aucun des deux tests
Else
ws.Cells(i, "E").Interior.Color = RGB(200, 200, 200) 'un seul des deux tests
End If
End If
End If
Next i
End Sub |