Bonjour 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
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
Re @Yeahou : Je te remercie pour ta suggestion. J'ai monté ce petit fichier juste pour illustrer la problématique.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, @+
Ok, alors pour les accents, vois cette fonction en v1.2 pour convertir tes chaînes en majuscules non accentuéesVoilà, le pourquoi de ma demande.
''''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
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
' 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
Non, pas lorsqu'on la crée dans une fonction.C'est Ultra rapide avec l'expression régulière
Bonjour Job75Bonsoir à 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,le forum,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+
''''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