Recherche dans une string (asterisque, étoile)

Commenter

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

S'inscrire maintenant

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.

Du même auteur (MajorDOOM)