[XL-2002] Optimisation code pour générer des balises richtext

Optimisation code pour générer des balises richtext

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 VIP de 150m<E>2</E> vous accueillera pour vous offrir les meilleures 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 -> VIP Reste ensuite à faire le ménage en suprimant les balises "" pour obtenir seulement le mot correctement encadré : VIP

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:

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:

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 & "" & .Text & "" '-- ITALIC ------------- ElseIf .Font.Italic Then Traduction = Traduction & "" & .Text & "" '-- 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, "", "") Traduction = Replace(Traduction, "", "") 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 !!

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

Et commence ta macro par

Code:

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:

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:

OPTION EXPLICIT

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

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:

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 & "" & .Text & "" '-- ITALIC ------------- ElseIf .Font.Italic Then Traduction = Traduction & "" & .Text & "" '-- 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, "", "") Traduction = Replace(Traduction, "", "") 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

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

Code:

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+

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