Recherche dans une string (asterisque, étoile)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 422 fois - Téléchargée 43 fois

Contenu du snippet

Cette fonction Asterisk permet de comparer deux strings

exemple :
Nom = "*bonj*vb*e" et NomEntier="Bonjour Vb France !"
Asterisk(Nomentier,Nom) ===> True

Nom = "*bondqsd*e" et NomEntier="Bonjour Vb France !"
Asterisk(Nomentier,Nom) ===> False

Source / Exemple :


Function Asterisk(ByVal Nomentier As String, ByVal Nom As String) As Boolean
    Dim pt_encour As Integer
    Dim pt_encourEntier As Integer
    Dim C As String
    Dim X As Integer
    Asterisk = False
    pt_encour = 1
    pt_encourEntier = 1
    C = "*"
    RemoveMultipleChar Nom, C
    If InStr(Nomentier, C) Then Exit Function
    If Nom = C Then
        Asterisk = True
        Exit Function
    End If
    If InStr(Nom, C) <> 1 And InStr(Len(Nom), Nom, C) = Len(Nom) Then
        ch = Left(Nom, InStr(Nom, C) - 1)
        If Left(Nomentier, Len(ch)) <> ch Then Exit Function
    ElseIf InStr(Len(Nom), Nom, C) <> Len(Nom) And InStr(Nom, C) = 1 Then
        old_X = 0
        X = 1
        While old_X < X
            ch = Right(Nom, Len(Nom) - X + 1)
            old_X = X
            X = InStr(X, Nom, C) + 1
        Wend
        If Right(Nomentier, Len(ch)) <> ch Then Exit Function
    ElseIf InStr(Nom, C) <> 1 And InStr(Len(Nom), Nom, C) <> Len(Nom) Then
        If InStr(Nom, C) = 0 Then
            If Nom = Nomentier Then
                Asterisk = True
                Exit Function
            End If
        Else
            ch = Left(Nom, InStr(Nom, C) - 1)
            If Left(Nomentier, Len(ch)) <> ch Then Exit Function
                    old_X = 0
            X = 1
            While old_X < X
                ch = Right(Nom, Len(Nom) - X + 1)
                old_X = X
                X = InStr(X, Nom, C) + 1
            Wend
            If Right(Nomentier, Len(ch)) <> ch Then Exit Function
        End If
    End If
    Asterisk = False
    Nom = "*" & Nom & "*"
    RemoveMultipleChar Nom, C
    pt_encour = 2
    ch = ""
    While (pt_encour <= Len(Nom))
        extrait = Mid(Nom, pt_encour, 1)
        If extrait = C Then
            If InStr(pt_encourEntier, Nomentier, ch) = 0 Then
                Asterisk = False
                Exit Function
            Else
                pt_encourEntier = InStr(pt_encourEntier, Nomentier, ch) + Len(ch)
            End If
            ch = ""
        Else
            ch = ch + extrait
        End If
        pt_encour = pt_encour + 1
    Wend
    Asterisk = True
End Function

Private Sub RemoveMultipleChar(ByRef chaine As String, ByVal Char As String)
    Dim i As Integer
    Dim temoin As Boolean
    Dim extrait As String
    Dim ch As String
    ch = ""
    temoin = False
    ch = ""
    For i = 1 To Len(chaine)
        extrait = Mid(chaine, i, 1)
        If extrait = Char Then
            If temoin = True Then
            Else
                temoin = True
                ch = ch + extrait
            End If
        Else
            temoin = False
            ch = ch + extrait
        End If
    Next
    chaine = ch
End Sub

A voir également

Ajouter un commentaire

Commentaires

Messages postés
30
Date d'inscription
vendredi 11 octobre 2002
Statut
Membre
Dernière intervention
3 mai 2004

moi je trouve plus simple->

if "*bonj*vb*e" Like "Bonjour Vb France !" then

(lol)
Messages postés
1491
Date d'inscription
dimanche 19 novembre 2000
Statut
Modérateur
Dernière intervention
7 juillet 2014

Bin sur que c'est utile, si jme souvient bien Like n'est pas en ASP (ASP = VB + HTML), alors cette function serais très utile surtout sur ASPfr.com

@+
Messages postés
28
Date d'inscription
mardi 2 juillet 2002
Statut
Membre
Dernière intervention
3 décembre 2005

merci au fete pour cette astuce, je savais que cette operteur existait sous SQL mais j'avais jamais essayé en vb.. envore un truc qui sert a rien ;(
Messages postés
466
Date d'inscription
samedi 16 février 2002
Statut
Membre
Dernière intervention
20 avril 2007

Exact, en plus tu pouvais quand même faire moins long, genre :

Private Function MieuxQueAsterisk(ByVal NomEntier As String, ByVal Nom As String) As Boolean
Dim i, j As Integer
If String(Len(Nom), "*") = Nom Then
MieuxQueAsterisk = True
Exit Function
End If
i = 0
j = 1
Do
i = i + 1
If Mid(Nom, i, 1) = "*" Then
Do
i = i + 1
Loop Until Mid(Nom, i, 1) <> "*" Or i = Len(Nom)
If i > Len(Nom) Then i = Len(Nom)
Do Until Mid(NomEntier, j, 1) = Mid(Nom, i, 1) Or j >= Len(NomEntier)
j = j + 1
Loop
End If
If Mid(NomEntier, j, 1) <> Mid(Nom, i, 1) And Mid(Nom, i, 1) <> "*" Then
MieuxQueAsterisk = False
Exit Function
Else
j = j + 1
End If
Loop Until j >= Len(NomEntier)
MieuxQueAsterisk = True
End Function

(fais en 10-15 minutes, à optimiser je pense...)
C'est tjrs bon de développer des codes existants pour les débutants... ici l'opérateur LIKE
Tch@o
Messages postés
28
Date d'inscription
mardi 2 juillet 2002
Statut
Membre
Dernière intervention
3 décembre 2005

non tu te trompe pas
Afficher les 6 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.