FONCTIONS INTERESSANTES D'EXTRACTION DE TEXTE DANS UNE EXPRESSION

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

Télécharger le zip

27 juillet 2006 11:55:31 :

Ajout de la fonction NombreOccurences Public Function NombreOccurences(ByVal sExpression As String, _ ByVal sTexteRecherche As String, _ Optional ByVal lMethodeComparaison As VbCompareMethod = vbTextCompare) As Long

27 juillet 2006 12:12:36 :

Contrôle du cas sTexteRecherche est une chaine vide dans la fonction NombreOccurences ajout de la ligne "If sTexteRecherche = vbNullString Then Exit Function" dans la fonction qui évite de tourner en rond