Compter des cellules dont le texte n'est pas barré et qui ont le meme contenue

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

Erreur d'exécution "91":
Variable objet ou variable de bloc With non définie

Option Explicit

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 r2 As Range 'déclare la variable r2

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
    Set r2 = Columns(1).Find(cel.Value, , xlValues, xlWhole)
    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 r2.Offset(0, 1).Value = nb
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
End Sub