XL 2019 Extraire une chaine entre deux positions

[undo74]

Bonjour,
Je cherche à extraire une chaîne de caractère entre 2 positions après des tests avec les fonctions cherche et STXT le résultat n'est pas concluant
voir l'exemple en PJ colonne E il serait possible d'avoir une aide soit directement par une fonction Excel ou bien en vba.
PI:
les données dans la pj sont de fausse information.
je vous remercie par avance.

 

[soan]

À jean-staple, undo74, le fil,

oui, je suis matinal, hein ?

excuse-moi, j'ai oublié d'anonymiser mon post #25 :
j'ai parlé de ta femme Samantha et de ta très chère
belle-mère Endora.

soan

 

[Staple1600]

Re

=>undo74
Je te conseille d'explorer la voie PowerQuery.
Idéale pour les utilisateurs encore débutant en VBA.
A l'usage, c'est vraiment intuitif
(Il y a de nombreux tuto sur le web, sans compter les nombreux XLDnautes qui maitrisent cet outil (ils se reconnaitront )

Néanmoins, pour être complet, il manquait une solution qui utilise les expressions régulières (autre outil très puissant)
Voilà ce que cela donne avec ton fichier exemple.

Sub Extraction_avec_RegExp()
Dim i&, c, H, plg As Range:        Set plg = Cells(1).CurrentRegion
With CreateObject("Vbscript.Regexp")
    .Global = -1: .Pattern = "@(.*)(.*)-"
    For Each c In plg
    i = 0
        If .test(c) Then
        For Each H In .Execute(c)
        i = i + 1
        c.Offset(, i) = Replace(Replace(H, "@", ""), "-", "")
        Next H
    End If
    Next c
End With
End Sub

NB: Mais c'est vraiment plus rapide avec PowerQuery, puisque aucun code à écrire. Tout se pilote à la souris.

 

[undo74]

Bonjour @undo74, Staple,

j'ai trouvé une meilleure méthode !

c'est toujours une sub ; toujours avec la méthode super rapide
des tableaux ; même utilisation : Ctrl e ➯ travail effectué :

Regarde la pièce jointe 1091921

bonus supplémentaire : ça marche pareil quel que soit
le nombre d'adresses email : une, deux, ou plus !

---

autre bonus : ça marchera aussi s'il y a des prénoms
composés tels que jean-pierre ou jean-paul.

c'est le mari de Samantha et Endora qui vont être contents !

---

code VBA complet :

Sub GetNoms()
  Dim dlg&: dlg = Cells(Rows.Count, 1).End(3).Row: If dlg < 3 Then Exit Sub
  Dim Tbl, txt$, lng%, s1$, s2$, p1%, p2%, lig&
  dlg = dlg - 2: Tbl = [A3].Resize(dlg, 2)
  For lig = 1 To dlg
    txt = Tbl(lig, 1): lng = Len(txt): If lng = 0 Then GoTo 1
    s2 = "": p1 = 1
    Do
      p1 = InStr(p1, txt, "(@"): If p1 = 0 Then Exit Do
      p2 = InStr(p1 + 2, txt, ")"): If p2 = 0 Then Exit Do
      s1 = Mid$(txt, p1 + 2, p2 - p1 - 2)
      p1 = InStrRev(s1, "-"): If p1 > 0 Then s1 = Left$(s1, p1 - 1)
      s2 = s2 & s1 & ", ": p1 = p2 + 1
    Loop
    If s2 <> "" Then Tbl(lig, 2) = Left$(s2, Len(s2) - 2)
1 Next lig
  Application.ScreenUpdating = 0
  With [B3].Resize(dlg)
    .ClearContents
    .Value = Application.Index(Tbl, Evaluate("Row(" & "1:" & dlg & ")"), 2)
  End With
End Sub

soan

Hello Soan, TOP TOP ta solution Merci infiniment à toi et aux autres participants.
Je suis désolé si ma demande n'est pas très clair

 

[Staple1600]

Re

=>under74
Tu as essayé la méthode PowerQuery?

 

[undo74]

Re

=>under74
Tu as essayé la méthode PowerQuery?

re Staple1600, non je n'ai pas encore fais de test avec du PowerQuery je te tiens au courant.
Merci encore la dernière solution de Soan post

Re

=>under74
Tu as essayé la méthode PowerQuery?

Re Staple1600, non je n'ai pas encore testé avec du PowerQuery je te tiens au courant.
Merci bcp la dernière solution de Soan post #25 me convient le plus.
Par compte ton dernier code post #32 répond à demande mais je ne peux pas l'exploiter car il est possible que d'autres cas que je n'ai pas identifié dans mon fichier exemple ne passe pas.
Encore merci...

 

[soan]

@Staple1600, le fil,

avec tes 2 solutions #30 et #32 (PowerQuery et RegExp),
j'ai failli renoncer à poster ma solution #25.

comme quoi plusieurs solutions valent mieux qu'une
(ou même que deux ou trois autres).

soan

 

[Staple1600]

Re

=>under74
[avis personnel]
C'est dommage de ne pas exploiter ce que t'offre Excel 2019
=>PowerQuery
Plus je l'utilise, plus j'en découvre les avantages.
Avantages qui me rappellent le mantra posé sur ma table de chevet
Toujours utiliser les fonctions natives offertes par sa version Excel avant de penser VBA

[avis personnel]

Mais je ne peux pas l'exploiter car il est possible que d'autres cas que je n'ai pas identifié dans mon fichier exemple ne passe pas.

Cela, tu ne peux l'affirmer qu'après avoir tester en situation réelle.

Avec RegExp, toutes les chaines qui respectent le pattern seront trouvées.

NB: Si tu as des questions sur la méthode PowerQuery, n'hésite pas.
je t'expliquerai en pas à pas.

 

[Modeste geedee]

@Staple1600 à dit :
Toujours utiliser les fonctions natives offertes par sa version Excel avant de penser VBA
idéal pour les utilisateurs encore débutant
A l'usage, c'est vraiment intuitif
aucun code à écrire. Tout se pilote à la souris.

sans code, ni formule
le B.A. BA des feuilles de calculs en quelque sorte ...

La solution :
sélectionner la colonne souhaitée
1 -
Menu Edition > Remplacer
Remplacer :
*@
par :
rien (laisser vide)
> remplacer tout
2 -
Menu Edition > Remplacer
Remplacer :
-*
par :
rien (laisser vide)
> remplacer tout

si l'on absolument à une macro :

Sub Macro2()'
    Columns("A:A").Select
    Selection.Replace What:="-*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="*@", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

A noter :
dans le cas ou 2 chaines correspondantes sont dans la même cellule
on pourra inverser l'ordre des 2 instructions ci-dessus
pour isoler l'une ou l'autre des chaines voulues

 

[Staple1600]

@Staple1600, le fil,

avec tes 2 solutions #30 et #32 (PowerQuery et RegExp),
j'ai failli renoncer à poster ma solution #25.

comme quoi plusieurs solutions valent mieux qu'une
(ou même que deux ou trois autres).

soan

Bonjour soan

Comme je ne commence que depuis peu avec PowerQuery, je me suis fourvoyé en allant dans VBA.
Ce n'est qu'en voyant le préfixe de la discussion que j'ai pensé PowerQuery
(qui à mon sens est "la meilleure solution") car non figée.
1) on peut choisir le fichier source (avec un vaste choix)

2) Tout se pilote à la souris
3) Vérificateur de syntaxe requête (en langage M)
4) requête actualisable
5) On obtient un tableau structuré (avec ses avantages donc)
Bref l'idéal pour un utilisateur "débutant confirmé" d'Excel.

Mais ce n'est que mon opinion.

PS: Ceci viole la relativité d'Einstein

avec tes 2 solutions #30 et #32 (PowerQuery et RegExp),
j'ai failli renoncer à poster ma solution #25.

A moins que ce soit un hommage caché à Marty et au Doc.

 

[soan]

@Staple1600, le fil,

pour ceux qui ont comme moi Excel 2007, il n'y a pas de PowerQuery,
même pas en add-on ; c'est seulement pour Excel 2010 et Excel 2013
qu'il y a un add-on PowerQuery ; enfin, pour Excel 2016 et ultérieur,
PowerQuery est intégré : voir sur l'onglet Données.

comme le demandeur @undo74 a Excel 2019, ça tombe bien.
ma solution #25 pourra quand même servir pour d'autres lecteurs
de la conversation qui n'ont pas PowerQuery sur leur PC, ou qui
préfèrent quand même VBA.

soan

 

[Staple1600]

Re

=>soan
Chacun trouve chaussure à son pied dans les fils d'XLD.
Mais l'essentiel n'est-il pas d'inciter/inviter le demandeur ou "le novice Excel" à utiliser les fonctions de base d'Excel ?
(Ce que j'ai mal fait. Mea culpa)

N'en reste pas moins un dernier •
Qui est que tu as quand même "violé" les lois de l'Univers
(cf PS message#39)

 

[laurent950]

Bonjour @soan , @Staple1600 , @Modeste geedee , Le Forum

Variante du code de @soan qui est super en Poste #25
avec cette idée

On Error Resume Next
' Les conditions "-" ou ")" ou "(" ect. sont remplacé par "|".
      T(i) = Replace(T(i), "-", "|") ' Les conditions
      T(i) = Replace(T(i), ")", "|")
      T(i) = Replace(T(i),...... Etc.
On Error GoTo 0

Le code de @Staple1600 en Poste #32 est Top (super l'utilisation des Regex) et Bonne idée aussi PowerQuery

Sub test()
Dim Rgn As Range
    Set Rgn = Range(Cells(3, 1), Cells(5, 2))
    For Each Rgn In Rgn
        Dim T As Variant
            T = Split(Rgn(, 1), "@")
                For i = 1 To UBound(T)
                On Error Resume Next
                ' Les conditions "-" ou ")" ou "(" ect. sont remplacé par "|".
                    T(i) = Replace(T(i), "-", "|") ' Les conditions
                    T(i) = Replace(T(i), ")", "|")
                On Error GoTo 0
                    If i = 1 Then Rgn(, 2) = Split(T(i), "|")(0) Else Rgn(, 2) = Rgn(, 2) & ", " & Split(T(i), "|")(0)
                Next i
    Next Rgn
End Sub

Cdt

 

[Staple1600]

Re

=>laurent950
Tu remets une pièce dans le nourrain...
Alors qu'on essaie ne pas utiliser VBA.
(Enfin on est au moins deux )
Mes codes ne sont absolument pas supers.
Ils fonctionnent.
Mais ils sont figés.
Alors que PowrQuery est dynamique et ne nécessite aucune connaissance VBA.

Prêchez dans le désert, il en restera toujours quelque chose.

 

[soan]

@Staple1600 : si, si, j'avais vu ton PS sur Marty et Doc.

@Modeste geedee et @laurent950 : bonjour !

soan