Microsoft 365 Gestion des doublons

Sub testResultat()
'
' ajout de regex
    Dim reg As Object
        Set reg = CreateObject("VBScript.RegExp")
    Dim Matches As Object
'
Dim F1 As Worksheet
    Set F1 = Worksheets("à_Traiter")
Dim F2 As Worksheet
    Set F2 = Worksheets("Resultat")
Dim tab1() As Variant
    tab1 = F1.Range(F1.Cells(6, 1), F1.Cells(F1.Cells(65536, 1).End(xlUp).Row, 31))
ReDim Preserve tab1(LBound(tab1, 1) To UBound(tab1, 1), LBound(tab1, 2) To UBound(tab1, 2) + 1)
    For i = LBound(tab1, 1) To UBound(tab1, 1)
        For j = i + 1 To UBound(tab1, 1)
            If tab1(i, 7) = tab1(j, 7) Then
                tab1(j, UBound(tab1, 2)) = tab1(j, 7)
            End If
        Next j
    Next i
ReDim Preserve tab1(LBound(tab1, 1) To UBound(tab1, 1), LBound(tab1, 2) To UBound(tab1, 2) + 1)
    For i = LBound(tab1, 1) To UBound(tab1, 1)
    Debug.Print i
        If tab1(i, UBound(tab1, 2) - 1) = Empty Then
            For j = i To UBound(tab1, 1)
                If tab1(i, 7) = tab1(j, 7) Then
                    If tab1(i, UBound(tab1, 2)) = Empty Then
                        tab1(i, UBound(tab1, 2)) = tab1(i, UBound(tab1, 2)) & tab1(j, 31)
                        Debug.Print tab1(j, 31)
                    Else
                        ' Recherche si chaine déja présente !
                            reg.Pattern = tab1(j, 31)
                            Set Matches = reg.Execute(tab1(i, UBound(tab1, 2)))
                            ' Si Vrai = existe
                            ' si Faux = n'existe pas !
                            ' MsgBox reg.test(tab1(i, UBound(tab1, 2)))
                            If reg.test(tab1(i, UBound(tab1, 2))) = False Then
                                ' Comme faux cela copie le commentaire.
                                tab1(i, UBound(tab1, 2)) = tab1(i, UBound(tab1, 2)) & tab1(j, 31)
                                Debug.Print tab1(j, 31)
                            End If
                    End If
                End If
            Next j
        End If
    Next i

Dim tabtemp() As Variant
tabtemp = tab1
ReDim Preserve tabtemp(LBound(tab1, 1) To UBound(tab1, 1), LBound(tab1, 2) To UBound(tab1, 2) - 2)
For i = LBound(tab1, 1) To UBound(tab1, 1)
    tabtemp(i, UBound(tabtemp, 2)) = tab1(i, UBound(tab1, 2))
Next i
' Colle le resultat feuille resultat
F2.Cells(6, 1).Resize(UBound(tabtemp, 1), UBound(tabtemp, 2)) = tabtemp
F2.Activate
End Sub