Recherche de doublons de phrases dans word

Sub doublonsPhrases()
    Dim s1 As Range, s2 As Range
    Dim phr1 As String, phr2 As String, flag As Boolean
    For Each s1 In Selection.Sentences
        phr1 = reduction(s1.Text)
        flag = False
        For Each s2 In Selection.Sentences
            phr2 = reduction(s2.Text)
            If s1.Start < s2.Start Then
                If phr1 = phr2 Then
                    If Not flag And Not s1.HighlightColorIndex = wdYellow Then s1.HighlightColorIndex = wdBrightGreen: flag = True
                    s2.HighlightColorIndex = wdYellow
                End If
            End If
        Next s2
    Next s1
End Sub

Function reduction(s As String) As String
    Dim phr1, phr2() As String, i As Long, j As Long
    phr1 = Replace(Replace(Replace(s, ".", ""), ",", ""), ";", "")
    phr1 = Replace(Replace(Replace(Replace(phr1, Chr(160), " "), vbLf, ""), vbCr, ""), vbCrLf, "")
    phr1 = Split(phr1, " ")
    ReDim phr2(1 To UBound(phr1) + 1)
    For i = 0 To UBound(phr1)
        If Len(phr1(i)) > 3 Then
            j = j + 1: phr2(j) = phr1(i)
        End If
    Next i
    ReDim Preserve phr2(1 To j)
    reduction = Trim(Join(phr2, " "))
End Function