Extraire un groupe de caractères vers une seule cellule, selon condition

[Nougatine95]

Bonsoir Le Forum,

Après avoir ouvert des dizaines de posts afin d'y trouver une équivalence à ma recherche, je capitule.

Ma requête:
Extraire un groupe de caractères (caractères issus d'une chaîne de texte), vers une seule cellule, selon condition.

Petit fichier joint.
Il n'y a pas d'urgence!

En vous remerciant.

 

[david84]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Bonsoir,
une fonction personnalisée brute de décoffrage à tester :

Function RegrouperCar(c As String, Rang As Integer) As String
Dim s As Variant, i As Long, res As String, Nb As Integer
c = Replace(Replace(c, "[", "/"), "]", "/")
s = Split(c, "/")
For i = 1 To Len(s(0))
  res = res & Mid(s(0), i, 1) & " ": Nb = Nb + 1
Next i
s(0) = Left(res, Len(res) - 1): res = vbNullString
For i = 1 To Len(s(2))
  res = res & Mid(s(2), i, 1) & " ": Nb = Nb + 1
Next i
s(2) = Left(res, Len(res) - 1)
s = Split(Join(s))
If Rang - 1 <= Nb Then RegrouperCar = s(Rang - 1)
End Function

Pour l'utiliser :

=RegrouperCar($A3;COLONNES($A:A))

à tirer vers la droite et le bas.
A+

 

[R@chid]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Bonsoir @ tous,
Une variante par formule..
Voir PJ

@ + +

 

[Nougatine95]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Bonjour Le Forum,

Merci R@chid,

Je viens de voir la formule, c'est parfait.
Pour VBA, je teste dans la journée.

Tu es foor-mi-dable! Tous formidables!

Bonne journée.

 

[job75]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Bonjour à tous,

Avec les 4 noms définis Mot N X Y la formule en B21 est bien simple :

=REPT(STXT($A21;N;1);N<X)&REPT(Mot;N=X)&REPT(STXT($A21;N+NBCAR(Mot)+1;1);N>X)

A tirer à droite et vers le bas.

Fichier joint.

A+

 

[Nougatine95]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Bonjour Le Forum,

david84, R@chid, job75

Le code VBA fonctionne, les formules également.

Merci beaucoup les amis.

Lorsque j'ajoute des données sur cellule A3 par exemple,
PAAPP[SUOUR]MPTG --> PAAPP[SUOUR]MPTG[OPR]A

en effet il peut y avoir des cas où: plusieurs [] dans colonne A, de ce fait code et formules n'effectuent pas leur tâche jusqu'au bout.

Le code (david84) ne renvoie pas de cellule supplémentaire
Le résultat reste:
P A A P P SUOUR M P T G

Code :
Function RegrouperCar(c As String, Rang As Integer) As String
Dim s As Variant, i As Long, res As String, Nb As Integer
c = Replace(Replace(c, "[", "/"), "]", "/")
s = Split(c, "/")
For i = 1 To Len(s(0))
res = res & Mid(s(0), i, 1) & " ": Nb = Nb + 1
Next i
s(0) = Left(res, Len(res) - 1): res = vbNullString
For i = 1 To Len(s(2))
res = res & Mid(s(2), i, 1) & " ": Nb = Nb + 1
Next i
s(2) = Left(res, Len(res) - 1)
s = Split(Join(s))
If Rang - 1 <= Nb Then RegrouperCar = s(Rang - 1)
End Function

Pour l'utiliser :
Code :
=RegrouperCar($A3;COLONNES($A:A))
à tirer vers la droite et le bas.

***
Cette formule (R@chid):
=SI(COLONNES($B:B)<TROUVE("[";$A25);STXT($A25;COLONNES($B:B);1);SI(COLONNES($B:B)=TROUVE("[";$A25);STXT($A25;TROUVE("[";$A25)+1;TROUVE("]";$A25)-TROUVE("[";$A25)-1);STXT($A25;TROUVE("]";$A25)-TROUVE("[";$A25)+COLONNES($B:B);1)))

Et cette autre formule (job75):
=REPT(STXT($A21;N;1);N<X)&REPT(Mot;N=X)&REPT(STXT($A21;N+NBCAR(Mot)+1;1);N>X)

donnent:
P A A P P SUOUR M P T G [ O P R ] A

L'un d'entre vous peut-il intervenir?

Je vous en remercie.

 

[david84]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Bonjour, Rachid, Gérard,

Lorsque j'ajoute des données sur cellule A3 par exemple,
PAAPP[SUOUR]MPTG --> PAAPP[SUOUR]MPTG[OPR]A

en effet il peut y avoir des cas où: plusieurs [] dans colonne A, de ce fait code et formules n'effectuent pas leur tâche jusqu'au bout.

J'en conclus que les 2 exemples présentés dans ton fichier ne sont pas explicites...à tester et à vérifier de ton côté :

Function RegrouperCar(c As String, Rang As Integer) As String
Dim s As Variant, i As Integer, j As Integer, res As String, Nb As Integer
If c = vbNullString Then Exit Function
c = Replace(Replace(c, "[", "/|"), "]", "|/")
s = Split(c, "/")
For i = LBound(s) To UBound(s)
  If s(i) Like "|*|" Then
    s(i) = Replace(s(i), "|", ""): res = res & s(i) & " ": Nb = Nb + 1
  Else
    For j = 1 To Len(s(i))
      res = res & Mid(s(i), j, 1) & " ": Nb = Nb + 1
    Next j
  End If
Next i
res = Left(res, Len(res) - 1)
s = Split(res)
If Rang - 1 < Nb Then RegrouperCar = s(Rang - 1)
End Function

A+

 

[Nougatine95]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Bonjour, Rachid, Gérard,


J'en conclus que les 2 exemples présentés dans ton fichier ne sont pas explicites...

En effet david84, R@chid, job75, j'ai mal développé.

Je viens de copier et remplacer par ce code,
le résultat reste identique

PAAPP[SUOUR]MPTG[OPR]A
renvoie
P A A P P SUOUR M P T G

 

[david84]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

En effet david84, R@chid, job75, j'ai mal développé.

Je viens de copier et remplacer par ce code,
le résultat reste identique

PAAPP[SUOUR]MPTG[OPR]A
renvoie
P A A P P SUOUR M P T G

Chez moi

PAAPP[SUOUR]MPTG[OPR]A

renvoie

P A A P P SUOUR M P T G OPR A

C'est bien le résultat attendu, non ?
A+

 

[job75]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Re,

Une fonction VBA différente de celle de David :

Function Crochets(t$, ordre%)
Dim i%, x$, grp As Boolean, n%
For i = 1 To Len(t)
  x = Mid(t, i, 1)
  If Not grp And x <> "[" Then
     Crochets = x
     n = n + 1
  ElseIf x <> "]" Then
    grp = True
    Crochets = Crochets & x
  Else
    grp = False
    n = n + 1
    Crochets = Mid(Crochets, 3 + (Left(Crochets, 1) = "["))
  End If
  If n = ordre Then Exit Function
Next
Crochets = ""
End Function

Je crains qu'elle ne soit moins rapide, il faudrait tester la durée d'exécution.

Fichier (2).

A+

 

[Staple1600]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Bonsoir à tous , job75


david84
Tu as bien un petit pattern de derrière les fagots pour ce genre de question, non ?
Parce que moi mon RegExp est un peu rouillé et JNP se fait de plus en plus rare

 

[Nougatine95]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Bonsoir Le Forum,
R@chid, job75, david74, Staple1600

Merci job75, david74 pour vos propositions de codes.
Après avoir re puis re-tester ton code david74, le copier-coller me renvoie 1 fois sur 2, des infos en rouge (dans le code), je verrai cela demain.

job75, test OK sur fichier récupéré sur site; mais toujours ce problème de code en rouge lorsque je fais à l'identique dans mon fichier.
Suis loin d'être au top côté VBA, ça commence à me prendre la tête.

Merci pour votre dévouement.
@ demain.

Bonne soirée.

 

[david84]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Bonsoir à tous , job75


david84
Tu as bien un petit pattern de derrière les fagots pour ce genre de question, non ?
Parce que moi mon RegExp est un peu rouillé et JNP se fait de plus en plus rare

Bon alors juste pour te faire plaisir :

Function RegrouperCar(c As String, Rang As Integer) As String
Dim Reg As Object, Matches As Object
If c = vbNullString Then Exit Function
Set Reg = CreateObject("vbscript.regexp")
With Reg
  .Global = True
  .IgnoreCase = True
  .Pattern = "([A-Z]|[[A-Z]+])"
  If .test(c) = True Then Set Matches = .Execute(c)
End With
If Rang - 1 < Matches.Count Then RegrouperCar = Replace(Replace(Matches(Rang - 1), "[", ""), "]", "")
End Function

Si les chaînes de caractères comportent autre chose que des caractères alphabétiques il faudra modifier le pattern en conséquence.
A+

 

[job75]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Re,

Ma crainte n'était pas fondée

Sur Win Xp - Excel 2003 j'ai testé mon fichier (2) sur 20000 lignes avec cette macro :

Sub Test()
Dim t
t = Timer
[A21:Q24].Copy [A25:Q20020]
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Avec la fonction de David84 => 18,88 secondes

Avec la fonction de job75 => 10,11 seconde.

A+

 

[job75]

Re : Extraire un groupe de caractères vers une seule cellule, selon condition

Re,

Avec la macro de David du post #13 => 9 minutes 19 secondes

Cela confirme que regexp est fort peu brillant en terme de durée d'exécution.

A+