XL 2016 Récupérer dans un libellé un mot avant une cassure

[Armand11]

Bonjour la communauté Exceldownload,

Tout d'abord meilleurs voeux pour cette nouvelle année.
J'ai besoin de votre aide pour récupérer en automatique un mot d'un libellé :

Voici mon libellé :
"Total Bill Variance//PO 1-23-001993//SUPP59 Thorlabs//AP4M3M"

Et je dois récupérer SUPP59 c'est à dire tous les SUPP et ce qu'il y a aprés jusquà la cassure c'est à dire l'espace avant "Thorlab".

J'ai essayé de combiner les formules STXT(A8;36;8) et ensuite un Gauche(A9;6) mais dans certain cas ca ne marche pas. Car en fait mes Codes Fournisseurs peuvent être : SUPP30 ou SUPP1 ou SUPP1984 (ils ne dépassent pas 8 caractères)

Merci beaucoup pour votre aide
Armand

 

[job75]

Bonjour le forum,

Ho le joli GoTo 😀

Oui bien sûr on peut le remplacer par Exit For (comme pour le 2ème test) mais c'est peut-être moins clair :

Function Extrait$(txt$, crit1$, crit2$)
Dim L1%, L2%, L, i%, j%, a(), n%
L1 = Len(crit1)
L2 = Len(crit2)
L = Len(txt)
For i = 1 To L
    If Mid(txt, i, L1) = crit1 Then
        For j = i + L1 To L
            If Mid(txt, j, L1) = crit1 Then i = j - 1: Exit For
            If Mid(txt, j, L2) = crit2 Then
                ReDim Preserve a(n)
                a(n) = Mid(txt, i, j + L2 - i) 'avec le 2ème critère (espace)
                n = n + 1
                i = j
                Exit For
            End If
        Next j
    End If
Next i
If n Then Extrait = Join(a, "") 'concaténation sans séparateur
End Function

A+

 

[Nain porte quoi]

Hello,

pour le fun, juste pour éviter le GoTo 😱 ou la sortie (brutale 😀) de la boucle

Function Extrait$(txt$, crit1$, crit2$)
    Dim L1%, L2%, L, i%, j%, a(), n%
    Dim Trouve As Boolean
    L1 = Len(crit1)
    L2 = Len(crit2)
    L = Len(txt)
    i = 1
    While i <= L
        If Mid(txt, i, L1) = crit1 Then
            j = i + L1
            Trouve = False
            While j <= L And Not Trouve
                If Mid(txt, j, L1) = crit1 Then
                    i = j - 1
                    Trouve = True
                ElseIf Mid(txt, j, L2) = crit2 Then
                    ReDim Preserve a(n)
                    a(n) = Mid(txt, i, j + L2 - i) 'avec le 2ème critère (espace)
                    n = n + 1
                    i = j + L2 - 1
                    Trouve = True
                Else
                    j = j + 1
                End If
            Wend
        End If
        i = i + 1
    Wend
    If n > 0 Then Extrait = Join(a, "") 'concaténation sans séparateur
End Function