Séparer du texte sur 3 en fonction de la mise en forme

[sofysofe]

Séparer du texte sur 3 colonnes en fonction de la mise en forme

Bonjour,

J'ai besoin, pour pouvoir conserver un mise en forme lors d'un publipostage avec Word, d'extraire un morceau de texte en italique d'une cellule.

En fait, dans ma colonne Citation, "Prénom Nom, Citation, autres références.

Je ne vois pas d'autre solution que de diviser le contenu de ces cellule en trois, de la façon suivante :
1ère colonne : Prénom Nom + la dernière virgule (il peut parfois y en avoir beaucoup, séparés par des virgules, c'est pour quoi je n'utilise pas la fct intégrée à Excel qui permet de diviser en plusieurs colonnes)
2ème colonne : citation (qui apparait tj en italique, c'est le seul point commun dans toutes mes lignes)
3ème colonne : "virgule qui suit la citation dans colonne originale" + tout le texte qui suit.

J'espère être claire ...

En fait, ça m'évitera de devoir formatter mon doc word une fois fusionné, car ça me ferait un millier de mise en forme ...

Merci d'avance !

 

[Guest]

Re : Séparer du texte sur 3 en fonction de la mise en forme

Bonjour,

Voici une petite fonction qui extrait tout caractère italique d'une cellules.

Function ExtraireCitation(cellule As Range)
    Dim i As Integer
    Dim Citation As String
    With cellule
    For i = 1 To cellule.Characters.Count
        If cellule.Characters(i, 1).Font.Italic = True Then
            Citation = Citation + cellule.Characters(i, 1).Text
        End If
    Next i
    End With
    ExtraireCitation = Citation
End Function

En B2: =ExtraireCitation($A$1)
Attention, cela peut s'avérer assez long.

A+

 

[sofysofe]

Re : Séparer du texte sur 3 en fonction de la mise en forme

Merci !
C'est presque parfait ...
En fait, j'aimerai réellement extraire le texte en italic, càd, qu'il disparaisse complètement de la cellule d'origine, d'où ma demande pour les virgules et les trois colonnes.

Merci encore car je suis sûre que je m'en servirai sur autre chose !

Sofe

 

[pierrejean]

Re : Séparer du texte sur 3 en fonction de la mise en forme

bonjour sofysofe

Vois si cela te convient
Nb: J'ais pris la liberté de supprimer les virgules dans les colonnes B et D

Edit: Salut Hasco

 

[Staple1600]

Re : Séparer du texte sur 3 en fonction de la mise en forme

Bonsoir à tous



Pourquoi un petit coup de Données/Convertir

en ne distribuant pas la 1ère et 3ème colonnes

Ça prend moins d'une seconde


Ce qui donne en VBA:

Sub Macro1()
Range("A2:A" & [A65536].End(xlUp).Row).Font.Italic = True
Range("A2:A" & [A65536].End(xlUp).Row).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 9), Array(2, 1), Array(3, 9))
End Sub

 

[sofysofe]

Re : Séparer du texte sur 3 en fonction de la mise en forme

bonjour sofysofe

Vois si cela te convient
Nb: J'ais pris la liberté de supprimer les virgules dans les colonnes B et D

Edit: Salut Hasco

Salut Pierrejean, et merci de t'être penché sur ma requête !

C'est parfait !

En fait j'ai dû modifier un peu ton code, car je travaille sur la version US de Excel 2003, et du coup, au début, rien ne se passait ... Je n'ai eu qu'à remplacer "Italique" par "Italic" et ça a fonctionné !

Encore un grand merci pour toutes ces heures que tu me fais gagner !!

Je te souhaite un excellente journée !

Sofe

 

[sofysofe]

Re : Séparer du texte sur 3 en fonction de la mise en forme

Merci beaucoup pour ta réponse, mais en fait, je ne peux pas utiliser le Données/Convertir car dans mon fichier original, il y a parfois plusieurs virgules, et ça me créerai trop de colonne, donc du travail supplémentaire ...

 

[sofysofe]

Re : Séparer du texte sur 3 en fonction de la mise en forme

Oups ....! Et re-bonjour Pierrejean ...

Je viens de tester sur le fichier original qui contient beaucoup plus de lignes bien sûr, et ça me renvoi une erreur, que j'ai attachée en image.
La procédure tourne, il y a l'erreur, et le dipatch ne se fait pas sur certaines cellules ...
Any ideas ?

 

[pierrejean]

Re : Séparer du texte sur 3 en fonction de la mise en forme

Re

Quel est le texte des cellules ou le dispatch ne se fait pas ?
Et si possible quelle ligne est surlignée lors de l'erreur ?

 

[sofysofe]

Re : Séparer du texte sur 3 en fonction de la mise en forme

Alors, ça a commencé sur des cellules qui ne contenaient pas d'italique, je les ai passées en italique et c'est passé. Puis ça a recommencé à partir d'une cellule contenant le texte suivant :

Eric A. Schwartz, The effect of the arbitration agreement on the enforcement of the award: issues for the coming decade, ICC BULLETIN, SPECIAL SUPPLEMENT, ARBITRATION IN THE NEXT DECADE: PROCEEDINGS OF THE INTERNATIONAL COURT OF ARBITRATION'S 75TH ANNIVERSARY CONFERENCE 105 (1999)

et les lignes suivantes n'ont pas été traitées non plus.

La ligne surlignée est celle-ci :
fin = Range("AM" & m).Characters(n).Text
-> J'ai changé les references des cellules pour que ça colle dans mon fichier original ...

Merci d'avance ...

 

[pierrejean]

Re : Séparer du texte sur 3 en fonction de la mise en forme

Re

Il semble que cela soit du a la longueur du texte

teste modifier la ligne

fin = Range("A" & m).Characters(n).Text

par

fin = Range("A" & m).Characters(n, 255).Text

 

[sofysofe]

Re : Séparer du texte sur 3 en fonction de la mise en forme

C'est parfait !
Tout fonctionne parfaitement maintenant !

Un grand merci !

Sofe

 

[pierrejean]

Re : Séparer du texte sur 3 en fonction de la mise en forme

Voici je crois mieux encore:

Sub decoupage()
For m = 2 To Range("A65536").End(xlUp).Row
ensuite = Len(Range("A" & m))
For n = 1 To Range("A" & m).Characters.Count
 If n < ensuite And Range("A" & m).Characters(Start:=n, Length:=1).Font.Italic = True Then
   fin = Mid(Range("A" & m), n, ensuite - n)
   deb = Replace(Range("A" & m), fin, "")
   ensuite = n
   Range("B" & m) = Replace(deb, ",", "")
 End If
 If n > ensuite And Range("A" & m).Characters(Start:=n, Length:=1).Font.Italic = False Then
   suite = Mid(Range("A" & m), n, Len(Range("A" & m)) - n)
   milieu = Replace(fin, suite, "")
   Range("C" & m) = milieu
   Range("C" & m).Font.Italic = True
   Range("D" & m) = Replace(suite, ",", "")
   Exit For
 End If
Next n
Next m
End Sub

 

[sofysofe]

Re : Séparer du texte sur 3 en fonction de la mise en forme

Je viens de tester sur mon original, et en fait, c'est vrai que ça tourne plus vite, mais ça rajoute des caractères après les noms, au début ce sont des numéros, puis ensuite il y a des parenthèses qui apparaissent...

 

[pierrejean]

Re : Séparer du texte sur 3 en fonction de la mise en forme

Re

Difficile d'imaginer tous les cas particuliers
Fait une recapitulation des cas ou le resultat n'est pas satisfaisant et je regarderais s'il est est possible de faire une macro qui prenne tout en charge