Minimiser le temps de suppression des caractères spéciaux [Résolu]

Signaler
-
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
-
Bonjour tout le monde,

J'ai un grand problème avec la macro VBA ci-dessous.
Au fait je dois supprimer les caractères spéciaux d'un document Word. Admettant que je ne garderais que les lettre en minuscule ou majuscule. Quand je lance cette macro sur un petit fichier (1000 à 2000 caractères) j'ai pas de problème ça me prend moins de 30 secondes mais dès que je la lance sur grand fichier (40000 à 50000 caractères soit près de 12 pages) j'ai l'impression que le temps d'exécution n'est plus proportionnel et ça me prend près de 2H35 pour terminer l'exécution. Sachant que j'ai près de 150 fichier l'exécution me prendra alors des semaines.
S'il vous plait n'hésitez pas à me proposer toute idée aussi simple qu'elle soit.

Merci,


Sub delete_special_char()
Dim curDoc As Document
Dim ascii As Integer
Dim chr As Variant
Dim i As Long

Set curDoc = ActiveDocument

i = 1

Do While (i < curDoc.Characters.Count)
chr = curDoc.Range.Characters(i)
ascii = Asc(chr)
If (ascii < 65 Or 90 < ascii) And (ascii < 97 Or 122 < ascii) Then
curDoc.Range.Characters(i).Delete
Else
i = i + 1
End If
Loop
End Sub

10 réponses

Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
229
Bonjour,
Je ne pratique pas du tout VBA/Word, mais devine assez bien que :
Do While (i < curDoc.Characters.Count)
chr = curDoc.Range.Characters(i)

parcourt en fait curdoc comme il parcourrait une chaîne de caractères, caractère par caractère. Il est alors clair que le processus sera lent si la chaîne à traiter est très longue.
Je te suggère de la transformer en tableau et de traiter le tableau (beaucoup plus rapide). Intéresse-toi donc à l'utilisation de la fonction StrConv (pour avoir un tableau) et de Join (pour recomposer ta chaîne après traitement).


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
229
Tu crois que tu as trouvé le plus rapide ,
Regarde ===>> (exemple)
For i = 1 To 10000
   toto = toto & "Un password megasuper long"
 Next
   Dim titi() As Byte
   titi = StrConv(toto, vbFromUnicode)
  

   For i = 0 To UBound(titi)
     'MsgBox Chr(titi(i))
     If Chr(titi(i)) "u" Then titi(i) 0
   Next
   
   'INTERESSANT !
    sstr = Replace(StrConv(titi, vbUnicode), Chr(0), "")
    MsgBox sstr



Moins de 1/10ème de secondespour traiter une châine de 770 000 caractères



________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Bon je crois que j'ai trouvé un moyen beaucoup plus rapide.

Merci quand même !

Sub delete_special_char1()
    Dim curPara         As Paragraph
    Dim curDoc          As Document
    Dim ascii           As Long
    Dim char             As Variant
    Dim lastChr         As Long
    Dim i               As Long
    Dim spChr           As String
    
    Set curDoc = ActiveDocument
    'char = chr(ascci)
        curDoc.Range.Select
    For ascii = 0 To 255
        If (ascii < 12 Or 14 < ascii) And (ascii <> 32) And (ascii < 65 Or 90 < ascii) And (ascii < 97 Or 122 < ascii) And (ascii < 192 Or 197 < ascii) And (ascii < 200 Or 207 < ascii) And (ascii < 210 Or 214 < ascii) And (ascii < 217 Or 220 < ascii) And (ascii < 224 Or 228 < ascii) And (ascii < 232 Or 239 < ascii) And (ascii < 244 Or 246 < ascii) And (ascii < 251 Or 252 < ascii) Then
            Selection.Find.Replacement.ClearFormatting
            With Selection.Find
                .Text = chr(ascii)
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchKashida = False
                .MatchDiacritics = False
                .MatchAlefHamza = False
                .MatchControl = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Find.Execute Replace:=wdReplaceAll
        End If
    Next ascii

End Sub
Merci beaucoup ucfoutu :) Le problème est résolu !
Désolé j'avais pas vue ton message précédent.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
229
Bon ...
Continuons donc (elle est là, ta solution rapide) :
For i = 1 To 10000
     toto = toto & "Voilà du texte d'où on veut supprimer le à, mais également le ù, indésirables"
   Next
   MsgBox "on va donc traiter une chaîne de " & Len(toto) & " caractères"
   
   ' c'est bien entendu à partir d'ici (chaîne à traiter étant construite, que l'on va
   ' "mesurer le temps d'exécution
   
   
   T = Timer
   Dim titi() As Byte
   titi = StrConv(toto, vbFromUnicode)
   For i = 0 To UBound(titi)
     Select Case titi(i)
       Case 224, 249 ' ====>> mets ici tes exclusions
        titi(i) = 0
     End Select
   Next
   
   sstr = Replace(StrConv(titi, vbUnicode), Chr(0), "")
   MsgBox "traité en " & Timer - T & " secondes"
   MsgBox sstr



________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Fantastic !
Traité en 0.0546875 s
Par contre j'aurais une question si vous permettez.

Si je veux stocker le texte de mon document word, quel type devrais-je utiliser par la variable toto ?
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
229
String, bien évidemment.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
229
Pas de quoi.
2H35 pour 50 000 caractères passés à 0.0546875 secondes pour 770 000 caractères, c'est pas mal, hein ?
Valide le dernier code, plutôt que le précédent


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.