Minimiser le temps de suppression des caractères spéciauxRésolu

Question

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

ucfoutu · Accepted Answer

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.

slachromana · Answer

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

ucfoutu · Answer

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.

slachromana · Answer

Merci beaucoup ucfoutu :) Le problème est résolu !
Désolé j'avais pas vue ton message précédent.

ucfoutu · Answer

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.

slachromana · Answer

Fantastic !
Traité en 0.0546875 s

slachromana · Answer

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 ?

ucfoutu · Answer

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.

slachromana · Answer

Merci

ucfoutu · Answer

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.

Minimiser le temps de suppression des caractères spéciaux

10 réponses

Votre réponse

Discussions similaires