Fonctions interessantes d'extraction de texte dans une expression

Télécharger le projet
Commenter

Description

Il s'agit de 4 fonctions que vous pourriez utiliser dans un module
InStr2 --> semblable à InStr, sauf que vous indiquez l'occurence du texte recherché
InStrRev2 --> semblable à InStrRev, sauf que vous indiquez l'occurence du texte recherché
ExtraitTexte --> permet d'extraire dans une chaine string, un texte compris entre 2 délimiteurs quelconques.
NombreOccurences --> permet de déterminer le nombre d'occurence d'un texte dans une expression

Source / Exemple : 


Option Explicit

Public Enum EnumSensRechercheTexte
    sr_GaucheVersDroite = 1
    sr_DroiteVersGauche = -1
End Enum

'Cette fonction différe de la fonction InStr de VB uniquement du fait du paramètre
'lOccurence.
'lOccurence : elle indique l'ordre de l'occurence du texte recherché
'   1=1ère occurence, 2=2ème occurence, ...
'  -1=dernière occurence, -2=avant dernière occurence, ...
Public Function InStr2(ByVal sExpression As String, _
    ByVal sTexteRecherche As String, _
    Optional ByVal lOccurence As Long = 1, _
    Optional ByVal lMethodeComparaison As VbCompareMethod = vbTextCompare) As Long
    
Dim lOccurenceEnCours As Long, lPosTexteRecherche As Long
    
    Select Case lOccurence
        Case Is > 0:
            Do
                lOccurenceEnCours = lOccurenceEnCours + 1
                lPosTexteRecherche = InStr(lPosTexteRecherche + 1, sExpression, sTexteRecherche, lMethodeComparaison)
            Loop While (lOccurenceEnCours < lOccurence) And (lPosTexteRecherche > 0)
            InStr2 = lPosTexteRecherche
        Case Is < 0: InStr2 = InStrRev2(sExpression, sTexteRecherche, -lOccurence, lMethodeComparaison)
        Case 0: InStr2 = 0
    End Select
End Function

'Cette fonction différe de la fonction InStrRev de VB uniquement du fait du paramètre
'lOccurence.
'lOccurence : elle indique l'ordre de l'occurence du texte recherché
'   1=1ère occurence, 2=2ème occurence, ...
'  -1=dernière occurence, -2=avant dernière occurence, ...
Public Function InStrRev2(ByVal sExpression As String, _
    ByVal sTexteRecherche As String, _
    Optional ByVal lOccurence As Long = 1, _
    Optional ByVal lMethodeComparaison As VbCompareMethod = vbTextCompare) As Long
    
Dim lOccurenceEnCours As Long, lPosTexteRecherche As Long
    
    Select Case lOccurence
        Case Is > 0:
            Do
                lOccurenceEnCours = lOccurenceEnCours + 1
                If lOccurenceEnCours <> 1 Then
                    lPosTexteRecherche = InStrRev(sExpression, sTexteRecherche, lPosTexteRecherche + Len(sTexteRecherche) - 2, lMethodeComparaison)
                Else
                    lPosTexteRecherche = InStrRev(sExpression, sTexteRecherche, , lMethodeComparaison)
                End If
            Loop While (lOccurenceEnCours < lOccurence) And (lPosTexteRecherche > 0)
            InStrRev2 = lPosTexteRecherche
        Case Is < 0: InStrRev2 = InStr2(sExpression, sTexteRecherche, -lOccurence, lMethodeComparaison)
        Case 0: InStrRev2 = 0
    End Select
End Function

'Cette fonction a pour but d'extraire le texte d'une expression texte compris entre
'deux délimiteurs textes.
'
'Paramètres:
'----------
'sExpression : Expression texte dans laquelle s'effectuera la recherche
'sDelimiteurGauche : Délimiteur gauche du texte à extraire
'sDelimiteurDroit : Délimiteur droit du texte à extraire
'lSensRecherche : sens de la recherche. +1=[De gauche Vers Droite], -1=[De Droite vers Gauche]
'lOccurence : elle indique l'ordre de l'occurence du texte recherché suivant le sens de recherche
'   1=1ère occurence, 2=2ème occurence, ...
'  -1=dernière occurence, -2=avant dernière occurence, ...
'lMethodeComparaison : méthode de comparaison pour les délimiteurs gauche et droit, de type VbCompareMethod
'
'Gestion d'erreur:
'-----------------
'Pour toute combinaison de paramètre incohérente la fonction renvoie une chaine vide
Public Function ExtraitTexte(ByVal sExpression As String, _
    ByVal sDelimiteurGauche As String, ByVal sDelimiteurDroit As String, _
    Optional ByVal lSensRecherche As EnumSensRechercheTexte = sr_GaucheVersDroite, _
    Optional ByVal lOccurence As Long = 1, _
    Optional ByVal lMethodeComparaison As VbCompareMethod = vbTextCompare) As String

Dim lPosDelimiteurRef As Long
Dim lPosGaucheResultat As Long, lPosDroiteResultat As Long, lPos2 As Long
    
    Select Case lSensRecherche
        Case sr_GaucheVersDroite:
            'Recherche de la position du délimiteur gauche suivant lOccurence
            If sDelimiteurGauche = vbNullString Then
                'Ne tient pas compte de lOccurence si le délimiteur gauche est une chaine vide
                lPosGaucheResultat = 1
            Else
                lPosDelimiteurRef = InStr2(sExpression, sDelimiteurGauche, lOccurence, lMethodeComparaison)
                If lPosDelimiteurRef > 0 Then lPosGaucheResultat = lPosDelimiteurRef + Len(sDelimiteurGauche)
            End If
                
            'Recherche la position du délimiteur droit pour ressortir le résultat
            If lPosGaucheResultat > 0 Then
                If sDelimiteurDroit = vbNullString Then
                    ExtraitTexte = Mid$(sExpression, lPosGaucheResultat)
                Else
                    lPos2 = InStr(lPosGaucheResultat, sExpression, sDelimiteurDroit, lMethodeComparaison)
                    'après ce calcul on a toujours soit lPos2=0 soit lPos2 >= lPosGaucheResultat
                    If lPos2 > 0 Then
                        lPosDroiteResultat = lPos2 - 1
                        ExtraitTexte = Mid$(sExpression, lPosGaucheResultat, lPosDroiteResultat - lPosGaucheResultat + 1)
                    End If
                End If
            End If
        Case sr_DroiteVersGauche:
            'Recherche de la position du délimiteur droit suivant lOccurence
            If sDelimiteurDroit = vbNullString Then
                'Ne tient pas compte de lOccurence si le délimiteur droit est une chaine vide
                lPosDroiteResultat = Len(sExpression)
            Else
                lPosDelimiteurRef = InStrRev2(sExpression, sDelimiteurDroit, lOccurence, lMethodeComparaison)
                If lPosDelimiteurRef > 0 Then lPosDroiteResultat = lPosDelimiteurRef - 1
            End If
                
            'Recherche la position du délimiteur gauche pour ressortir le résultat
            If lPosDroiteResultat > 0 Then
                If sDelimiteurGauche = vbNullString Then
                    ExtraitTexte = Left$(sExpression, lPosDroiteResultat)
                Else
                    lPos2 = InStrRev(sExpression, sDelimiteurGauche, lPosDroiteResultat, lMethodeComparaison)
                    'après ce calcul on a toujours soit lPos2=0 soit lPos2 <= lPosDroiteResultat
                    If lPos2 > 0 Then
                        lPosGaucheResultat = lPos2 + Len(sDelimiteurGauche)
                        ExtraitTexte = Mid$(sExpression, lPosGaucheResultat, lPosDroiteResultat - lPosGaucheResultat + 1)
                    End If
                End If
            End If
        Case Else:
    End Select
End Function

'Cette fonction permet de déterminer le nombre d'occurences d'un texte dans une expression
Public Function NombreOccurences(ByVal sExpression As String, _
    ByVal sTexteRecherche As String, _
    Optional ByVal lMethodeComparaison As VbCompareMethod = vbTextCompare) As Long
Dim lOccurenceEnCours As Long, lPosTexteRecherche As Long
    
        If sTexteRecherche = vbNullString Then Exit Function
        
        lPosTexteRecherche = InStr(1, sExpression, sTexteRecherche, lMethodeComparaison)
        Do While lPosTexteRecherche > 0
            lOccurenceEnCours = lOccurenceEnCours + 1
            lPosTexteRecherche = InStr(lPosTexteRecherche + 1, sExpression, sTexteRecherche, lMethodeComparaison)
        Loop
        NombreOccurences = lOccurenceEnCours
End Function

Conclusion :


je peux donner quelques résultats retournés par la fonction

ExtraitTexte("ababacx","aba","x",,1)="bac"
ExtraitTexte("ababacx","aba","x",,2)="c"
ExtraitTexte("ababacx","aba","x",,-1)="c"

ExtraitTexte("c:\dos1\dos2\dos3\mabd.mdb","\","")="dos1\dos2\dos3\mabd.mdb"
ExtraitTexte("c:\dos1\dos2\dos3\mabd.mdb","\","",,-1)="mabd.mdb"
ExtraitTexte("c:\dos1\dos2\dos3\mabd.mdb","\","\",sr_DroiteVersGauche,-2)="dos1"
ExtraitTexte("c:\dos1\dos2\dos3\mabd.mdb","\","\",sr_DroiteVersGauche,-3)"dos2"
ExtraitTexte("c:\dos1\dos2\dos3\mabd.mdb","\","\", sr_GaucheVersDroite ,-2)="dos3"
...

Signalez-moi si vous trouvez des bugs ou des algorithmes plus interessants, je suis preneur.
Télécharger le projet

Codes Sources

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 (cs_asimengo)