[CODE]Sub traiter()
Dim d As Variant 'variable numeric ou alphanumeric
t = Timer ' depart du chrono
Columns("A:A").Select ' Selection de toute la colonne A
'Tri la colonne A par ordre alphanumeric
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Départ à la ligne 1
i = 1
Do Until Cells(i, 1) = "" ' Revient tant que espace blanc pas trouvé
i = i + 1 'augmente la ligne de travail de 1 pour passer à la ligne suivante
Cells(1, 9) = i 'Affiche en $I$1 le numéro de la ligne traitée
d = Application.Match(Cells(i, 1), Range("B:B"), 0) ' Recherche en colonne B la valeur de la cellule colonne A de la ligne traitée
If IsNumeric(d) Then 'Si recherche dans la col A du numero (i)de la ligne trouvé en col B alors
Cells(d, 2) = "" 'Efface la cellule ligne trouvée en colonne B
Else 'Sinon
d = Application.Match(Cells(i, 1), Range("C:C"), 0) ' Recherche en colonne C la valeur de la cellule colonne A de la ligne traitée
If IsNumeric(d) Then 'Si recherche dans la col A du numero (i)de la ligne trouvé en col C alors
Cells(d, 3) = "" 'Efface la cellule ligne trouvée en colonne C
End If 'fin
End If 'fin de la recherche,la valeur de la cellule de la ligne i en colonne A , n'existe pas dans les colonnes B et C
Loop 'Retour à Do until pour traiter la ligne suivante
Columns("B:B").Select ' Selection de toute la colonne B
'Tri la colonne B par ordre alphanumeric pour enlever les espaces blancs
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("C:C").Select ' Selection de toute la colonne C
'Tri la colonne C par ordre alphanumeric pour enlever les espaces blancs
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Fin du chrono et message
MsgBox "Traitement Terminé " & Format(Timer - t, "0.00 s"), , "Fin du traitement"
End Sub 'Fin du sous programme