XL 2010 Vérifier Nom Prénom (comparaison lettre accentuée)

cp4

XLDnaute Barbatruc
Bonjour,

Je trouve des difficultés à effectuer la vérification des noms prénoms, afin de pas avoir de doublons.
Il se peut que dans les cellules de la colonne nom prénom, il y ait des espaces ajoutés par inadvertances.
J'ai donc introduit des espaces pour prendre ce cas en compte.
A ceci, s'ajoute la difficulté des lettres accentuées, ex: CARETTO Béatrice et CARETTO Beatrice.

Avec mes remerciements anticipés.

Bon dimanche.

edit: pour simplifier j'ai supprimé tous les espaces.
 

Pièces jointes

  • Find_Tb_Structuré_Casse.xlsm
    24.2 KB · Affichages: 7
Dernière édition:

cp4

XLDnaute Barbatruc
Re après modification

C'est maintenant ultra rapide, il n'y a plus de Récurcivité

VB:
''''verif client existe
Sub Test_Fonction()    'à exploiter
    Dim sNomClt As Boolean
    sNomClt = VerifClients(Range("B3"))
    If sNomClt = True Then
        MsgBox "Le client existe déjà"
    Else
        MsgBox "Le client n'existe pas"
        'créer client
        '[ °°°° Votre Code  °°°° ]
        '     ***************
        '[ °°°° Votre Code  °°°° ]
    End If
End Sub
VB:
Private Function VerifClients(ByRef TestFormatTexte As String) As Boolean
    Dim tb As Variant
    Dim i, j As Variant
    Dim TempText As String
    tb = Range("Tableau1[#All]")
    Dim RX As Object, itm As Object
    Set RX = CreateObject("VBScript.RegExp")
    Const sAccents As String = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
    Const sNoAccents As String = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
  
    ' Teste et Transforme le Format du texte envoyer (Sans accents et sans espaces)
       RX.Global = True
       RX.Pattern = "(.)"
       RX.Pattern = Mid(RX.Replace(sAccents, "|$1"), 2)
       For Each itm In RX.Execute(TestFormatTexte)
            TestFormatTexte = Trim(UCase(Replace(TestFormatTexte, itm, Mid(sNoAccents, InStr(1, sAccents, itm, 0), 1))))
       Next itm
            TestFormatTexte = Trim(UCase(TestFormatTexte))
    ' Test Si existe ou n'existe pas
        Dim Flag As Boolean
  
    For i = LBound(tb, 2) To 1
        For j = 2 To UBound(tb, 1)
            RX.Global = True
            RX.Pattern = "(.)"
            RX.Pattern = Mid(RX.Replace(sAccents, "|$1"), 2)
                For Each itm In RX.Execute(tb(j, i))
                    tb(j, i) = Replace(tb(j, i), itm, Mid(sNoAccents, InStr(1, sAccents, itm, 0), 1))
                Next itm
            tb(j, i) = Trim(UCase(tb(j, i)))
            'Le Test (si existe Flag = True)
            If TestFormatTexte = tb(j, 1) Then Flag = True: Exit For
        Next j
        If Flag = True Then Exit For
    Next i
' Renvois le test
VerifClients = Flag
End Function
Bonjour @laurent950, @job75 , @Yeahou , le forum.

Un grand merci à vous tous. Très sympa.
@laurent950 : Merci pour ta gentillesse inconditionnelle.
Bon week-end.
 

Statistiques des forums

Discussions
312 177
Messages
2 085 976
Membres
103 077
dernier inscrit
kamel26asus