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

[cp4]

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.

 

[ChTi160]

Bonjour cp4
en utilisant la fonction trim() pour les espaces et Ucase() pour comparaît les noms en majuscules .
Bonne fin de journée
Jean marie
Depuis mon téléphone

 

[cp4]

Bonjour cp4
en utilisant la fonction trim() pour les espaces et Ucase() pour comparaît les noms en majuscules .
Bonne fin de journée
Jean marie
Depuis mon téléphone

Bonjour ChTi160,

Merci beaucoup.
Oui, je connais bien ces 2 fonctions. Depuis ton téléphone, je comprends.
Le hic, c'est comment les utiliser correctement.

Option Explicit
Option Compare Text
Private Sub CbAjouter_Click()
    Dim cl As Range

    If Me.TextBox1 = "" Then Exit Sub
    Set cl = [tclient[NOM PRENOM]].Find(what:=TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole)

    If Not cl Is Nothing Then
        MsgBox cl & " existe!": Exit Sub
    Else
        MsgBox "ok, on ajoute: " & TextBox1
    End If
End Sub

Encore merci. Bon dimanche.

 

[Bernard_XLD]

Salut cp4, chti160, le forum

@cp4 , et cela ne serait pas plus simple d'utiliser une combobox alimentée par ton tableau ? tu verrais tout de suite en cours de saisie si les noms prénoms existent déjà.

Bien cordialement, @+

 

[cp4]

Salut cp4, chti160, le forum

@cp4 , et cela ne serait pas plus simple d'utiliser une combobox alimentée par ton tableau ? tu verrais tout de suite en cours de saisie si les noms prénoms existent déjà.

Bien cordialement, @+

Re @Yeahou : Je te remercie pour ta suggestion. J'ai monté ce petit fichier juste pour illustrer la problématique.
En fait, dans le véritable fichier la combobox existe pour la consultation et la modification.
La Textbox est utilisée lors de la création d'un client. D'où mon souhait de vérifier la présence ou non.
Le problème posé à un double objectif, l'un pour apprendre, l'autre pour aider.
Voilà, le pourquoi de ma demande.

Avec mes remerciements.

 

[Bernard_XLD]

re,

Voilà, le pourquoi de ma demande.

Ok, alors pour les accents, vois cette fonction en v1.2 pour convertir tes chaînes en majuscules non accentuées
https://www.excel-downloads.com/threads/majvsminsansaccent.20056425/
vois avec Application.Trim pour les doublons d'espaces et les espaces en début ou fin de chaine
vois aussi cette fonction pour modifier en une passe tous tes séparateurs différents
https://www.excel-downloads.com/threads/substituex.20057869/

Tu peux faire un tableau vb à partir de ton tableau structuré, modifier les valeurs avec les fonctions, appliquer les fonctions ensuite sur les chaines entrées pour effectuer la comparaison sur des bases identiques.

Bien cordialement, @+

 

[cp4]

Bonjour Yeahou,

Merci beaucoup. Je pense pouvoir m'en sortir avec ce qu'il sur tes 2 liens.
Auquel cas je reviendrais vers vous.

Bonne journée.

 

[laurent950]

Bonjour @cp4, @ChTi160, @Yeahou, le forum

C'est Ultra rapide avec l'expression régulière

Ordre 1

''''verif client existe
Sub Test_Fonction()    'à exploiter
    Dim sNomClt As String
    sNomClt = Trim(UCase(SANSACCENT(Range("B3"))))
    If VerifClients(sNomClt) 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

Ordre 2

Function SANSACCENT(ByVal s As String) As String
  Dim RX As Object, itm As Object
 
  Const sAccents As String = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
  Const sNoAccents As String = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "(.)"
  RX.Pattern = Mid(RX.Replace(sAccents, "|$1"), 2)
  For Each itm In RX.Execute(s)
    s = Replace(s, itm, Mid(sNoAccents, InStr(1, sAccents, itm, 0), 1))
  Next itm
  SANSACCENT = s
End Function

Ordre 3

' Retourne VRAI si la valeur n'est pas trouvée
Private Function VerifClients(ByVal Client As String) As String 'BrunoM45
    Dim tb As Variant
    Dim Texte As Boolean
    tb = Range("T_clients[#All]")
   
    ' Nota = LBound(tb, 2) les colonnes (regarder 2)
    '      = LBound(tb, 1) les colonnes (regarder 1)
    '      = Exit For (Je sort de la boucle = pas besoin de lire toute les lignes / Puis 1 Colonne ca va Vite
    For i = LBound(tb, 2) To 1   ' Juste la colonne 1 (Nom et Prénom) et comme Ubound(tb,2) = 2 donc 1
        For j = 2 To UBound(tb, 1) ' A partir de la ligne 1 soit hors Ligne avec les entêtes : soit LBound(tb, 1) = 1 et Donc 2
            If Client = Trim(UCase(SANSACCENT(CStr(tb(j, i))))) Then
                Texte = True
                Exit For
            End If
        Next j
    Next i
    VerifClients = Texte
End Function

 

[job75]

Bonsoir à tous,

C'est Ultra rapide avec l'expression régulière

Non, pas lorsqu'on la crée dans une fonction.

Car alors elle est recréée dans chaque cellule où se trouve la fonction, ça prend du temps.

Testez sur un grand tableau...

Bonne nuit.

 

[laurent950]

Bonsoir @job75

Merci pour cette information, je n'avais pas vu cette problématique. j'apprend aussi un peux plus chaque jour.

Je vous souhaite une bonne nuit aussi.

 

[cp4]

Bonjour Laurent, Job75,

Tous mes remerciements et gratitude.

Bonne journée.

 

[cp4]

Bonsoir à tous,

Non, pas lorsqu'on la crée dans une fonction.

Car alors elle est recréée dans chaque cellule où se trouve la fonction, ça prend du temps.

Testez sur un grand tableau...

Bonne nuit.

Bonjour Job75,

Merci pour ta pertinence. Mais si la fonction devait agir dans un array, le temps d’exécution serait beaucoup moindre?

Bonne journée.

 

[job75]

Bonjour cp4, le forum,

J'ai simplement voulu attirer l'attention sur le fait que l'instruction CreateObject("VBScript.RegExp") et celles qui suivent prennent du temps et que ce sera long si elles sont exécutées 10 ou 100 000 fois.

A+

 

[cp4]

Bonjour cp4, le forum,

J'ai simplement voulu attirer l'attention sur le fait que l'instruction CreateObject("VBScript.RegExp") et celles qui suivent prennent du temps et que ce sera long si elles sont exécutées 10 ou 100 000 fois.

A+

Bonjour Job75,le forum,

Merci beaucoup, j'ai compris.

Bonne journée.

 

[laurent950]

Re après modification

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

''''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

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