Discussion :

[stef_PBR]

Bonjour,

OBJECTIF : je dois récupérer la mise en forme de textes contenus dans des cellules Excel, pour générer des balises richtext interprétables dans un autre environnement.
Ex : "un espace VIP de 150m² vous accueillera pour vous offrir les meilleures prestations" -> "un espace <I>VIP</I> de 150m<E>2</E> vous accueillera pour vous offrir les <B>meilleures</B> prestations"

METHODE : Cellule après cellule, je parcours chaque caractère du texte et remplace ceux trouvés avec une mise en forme par une balise.
Ex : VIP -> <I>V</I><I>I</I><I>P</I> Reste ensuite à faire le ménage en suprimant les balises "</I><I>" pour obtenir seulement le mot correctement encadré : <I>VIP</I>

Voici donc le code utilisé : J'appelle ma fonction à partir d'une procédure d'où je passe le texte en paramètre (pas de souci à ce niveau) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
'-- Parcours de toutes les cellules et copie de la colonne In dans colonne Out ---
     For n = 2 To WorksheetFunction.CountA(Range("B:B"))            '-- Calcul du nombre de ligne avec ID
 
        Range(laColonneOut & n) = xls2balises(Range(laColonneIn & n))
        Range(laColonneOut & n).Select
 
    Next

la fonction elle même qui effectue la conversion (et c'est la que ca devient plus délicat) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
Public Function xls2balises(leTexte As Object) As String
    Dim k As Integer
    Dim Traduction As String
 
    Traduction = ""
 
         For k = 1 To Len(Characters)                         '-- Calcul du nombre de caractères dans la cellule = longueur du texte
            With leTexte .Characters(k, 1)                   '-- Parcours du texte caractère par caractère
                '-- GRAS ---------
                If .Font.Bold Then
                    Traduction = Traduction & "<B>" & .Text & "</B>"
 
                    '-- ITALIC -------------
                    ElseIf .Font.Italic Then
                        Traduction = Traduction & "<I>" & .Text & "</I>"
 
                    '-- EXPOSANT -------------
                    ElseIf .Font.Superscript Then
                        Traduction = Traduction & "<E>" & .Text & "</E>"
 
                    ElseIf .Text = "²" Then
                        Traduction = Traduction & "<E>2</E>"
 
                    ElseIf .Text = ChrW(13217) Then                 '-- Caractère "m²"
                        Traduction = Traduction & "m<E>2</E>"
 
                    Else
 
                        Traduction = Traduction & .Text
 
                End If
 
            End With
        Next
 
    DoEvents
 
    '-- NETTOYAGE DES BALISES PAR LETTRE -----------------------
    Traduction = Replace(Traduction, "</B><B>", "")
    Traduction = Replace(Traduction, "</I><I>", "")
    Traduction = Replace(Traduction, "</E><E>", "")
 
 
    xls2balises = Traduction

PROBLEME : (et oui ca serait trop beau) le code fonctionne très bien (ca parait étonnant) mais avec des performances assez aléatoires. Sur une première feuille, ca va aller correctement puis dès la seconde, les temps vont commencer sérieusement à augmenter alors que les textes sont souvent de même longueurs (env. 780 caract.). Cela finit par prendre 2 à 3 minutes par textes contre quelques secondes au départ. Bref, je suis sûr qu'il manque quelque chose mais je ne vois plus trop...

Un grand merci par avance pour vos idées inspirées qui permettront à cette (poussive) fonction de connaître des performances un peu meilleures !!

[Krovax]

Bonjour
si tu veux mon avis pour gagner un performance enlève ton .select qui est totalement inutile

Et commence ta macro par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

application.screenupdating=false

et a la fin de la macro tu le mets a TRUE

Par contre j'ai du mal a imaginé ce que tu veux faire puisque tu ajoute plein de balise pour a la fin toutes les virer (enfin c'est ce que tu veux faire je ne pense )pas que tu le fasse vraiment)
quand tu ecris

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Len(Characters)

que vau ta variable caractère? a mon avis rien don len(Characters)=0 et tu ne rentre jamais dans la boucle for
Commence par écrire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

OPTION EXPLICIT

Sur la toute première ligne de ton module avant la première macro

[stef_PBR]

Merci Krovax pour la rapidité de ta réponse.

Pour ce qui est du select, c'est possible en effet que cela affecte la performance, cela me permettait toutefois de savoir où en était le traitement...

Bon, en tout cas, en déselectionnant le .select et en rajoutant application.screenupdating=false/true, y'a un peu de mieux (si si) mais ca reste quand même encore (anormalement ?) long au fur et à mesure que mes différentes feuilles de classeurs sont parcourues...

Je me demandais si ce n'était pas ma série de conditions qui pouvait ralentir le traitement car si je la supprime alors tout se déroule très rapidement ? (peut-on optimiser cette enfilade de condistions ?)


Pour ce qui est de Len(Characters), tout a fait d'accord avec toi. En voulant bien faire j'ai rénommé ma variable (dans mon exemple, pas dans le code) pour plus de lisibilité... sauf à cet endroit.... Characters=leTexte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
Public Function xls2balises(leTexte As Object) As String
    Dim k As Integer
    Dim Traduction As String
 
    Traduction = ""
 
         For k = 1 To Len(leTexte)                         '-- Calcul du nombre de caractères dans la cellule = longueur du texte
            With leTexte.Characters(k, 1)                   '-- Parcours du texte caractère par caractère
                '-- GRAS ---------
                If .Font.Bold Then
                    Traduction = Traduction & "<B>" & .Text & "</B>"
 
                    '-- ITALIC -------------
                    ElseIf .Font.Italic Then
                        Traduction = Traduction & "<I>" & .Text & "</I>"
 
                    '-- EXPOSANT -------------
                    ElseIf .Font.Superscript Then
                        Traduction = Traduction & "<E>" & .Text & "</E>"
 
                    ElseIf .Text = "²" Then
                        Traduction = Traduction & "<E>2</E>"
 
                    ElseIf .Text = ChrW(13217) Then                 '-- Caractère "m²"
                        Traduction = Traduction & "m<E>2</E>"
 
                    Else
 
                        Traduction = Traduction & .Text
 
                End If
 
            End With
        Next
 
    DoEvents
 
    '-- NETTOYAGE DES BALISES PAR LETTRE -----------------------
    Traduction = Replace(Traduction, "</B><B>", "")
    Traduction = Replace(Traduction, "</I><I>", "")
    Traduction = Replace(Traduction, "</E><E>", "")
 
 
    xls2balises = Traduction

NB : J'ajoute plein de balises parce que je parcours mon texte caractère par caractère. En effet, je ne peux (du moins je ne sais pas) effectuer à l'intérieur d'une cellule, un "replace" d'un mot avec mise en forme par ce même mot encadré de balises adéqutes.

Merci encore

[LeForestier]

Bonjour,
Je pense que ce devrait être un peu plus rapide...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Public Function xls2balises(leTexte As Object) As String
    Dim k As Integer, A
    Dim Traduction As String, R As Integer
    Dim B As Boolean
    Dim I As Boolean
    Traduction = ""
 
         For k = 1 To Len(leTexte)  '-- Calcul du nombre de caractères dans la cellule = longueur du texte
            With leTexte.Characters(k, 1)  '-- Parcours du texte caractère par caractère
                '-- GRAS ---------
                If .Font.Bold Then
                    For R = k + 1 To Len(leTexte)
                        If Not leTexte.Characters(R, 1).Font.Bold Then Exit For
                    Next R
                    Traduction = Traduction & "<B>" & Mid(leTexte, k, R - k) & "</B>"
                    k = R - 1
 
                '-- ITALIC -------------
                ElseIf .Font.Italic Then
                    For R = k + 1 To Len(leTexte)
                        If Not leTexte.Characters(R, 1).Font.Italic Then Exit For
                    Next R
                    Traduction = Traduction & "<I>" & Mid(leTexte, k, R - k) & "</I>"
                    k = R - 1
                Else
                    Traduction = Traduction & .Text
                End If
            End With
           ' Debug.Print Traduction
        Next k
End Function

A toi d'ajouter les autre test.
J'ai tester sur les 2 test Gras et Italic, le texte n'était pas long mais la sortie imédiate !
A+

[stef_PBR]

Merci leForestier. J'ai fait tourner une première fois mes données avec ton code et les résultats ont été vraiment significatifs (pratiquement divisé par trois !).

Toutefois, je dois avouer être resté quelque peu perplexe devant les résultats suivants... En effet, j'ai de nouveau effectué le traitement sur les mêmes données et là... aie ! je me retrouve avec des temps anormalement longs. Quelque chose doit interférer avec ma fonction mais je ne vois pas trop...

Sur mes dernières tentatives, j'obtenais de nouveau des résultats rapides comme au premier coup. Je testerai tout cela sur de nouvelles données pour voir finalement vers quels résultats se fier.

Merci encore