Sub Macro1()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim nb As Integer 'déclare la variable nb (Nombre de cellules Barrées)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim mes As String 'déclare la variable mes (MESsage)
Application.ScreenUpdating = False 'masque les changements à l'écran
For Each cel In Range("B1:B" & Cells(Application.Rows.Count, 2).End(xlUp).Row) 'boucle sur toutes les cellules éditées cel de la colonne B
nb = 0 'initialise le nombre de cellules barrées
If cel.Font.Strikethrough = True And cel.Interior.ColorIndex <> 3 Then 'condition 1 : si la cellule est barrée et si elle n'est pas colorée en rouge
Set r = Columns(2).Find(cel.Value, , xlValues, xlWhole) 'définit la recherche
pa = r.Address 'définit la première adresse
Do 'ecécute
If r.Font.Strikethrough = True Then 'condition 2 : si l'occurrence trouvée est barrée
r.Interior.ColorIndex = 3 'colore l'occurrence trouvée de rouge
nb = nb + 1 'incrémente nb
End If 'fin de la condition 2
Set r = Columns(2).FindNext(r) 'redéfinit la recherche r (recherche suivante)
Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs qu'en pa
End If 'fin de la condition 1
'si nb n'est pas nul, définit le message
If nb > 0 Then mes = IIf(mes = "", nb & " " & cel.Value & ",", mes & Chr(13) & nb & " " & cel.Value & ",")
Next cel 'prochaine cellule de la boucle
Columns(2).Interior.ColorIndex = xlNone 'supprime la couleur rouge dans la colonne B
Application.ScreenUpdating = True 'affiche les changements à l'écran
MsgBox mes 'affiche le message mes
End Sub
