Excel corrompu?
Bonjour a tous, ca fait 10 heures que je travaille a regler un probleme bizarre: un traitement qui prenait 3 secondes en prend maintenant beaucoup plus. Et a chaque fois que je repete le traitement, le temps augmente de 3 secondes. Le traitement est un filtre elabore qui se fait par VBA. le resultat est toujours bon. J'ai mis Application.ScreenUpdating = true et je m'apercoit effectivement que le filtre elabore fonctionne tres lentement. De plus, apres le traitement, la feuille visee est tres lente, les autres feuilles sont correcte. J'ai enleve tout les sub evenementiel sans amelioration! Tout les fonctions implantes dans mon application fonctionnes!
Si j'essai une vielle version de mon application excel,, la vitesse est tjrs bonne.
j'ai reconstruit tout le code sur un nouveau fichier excel et le probleme est toujours present. Il semblerait donc qu'excel ne soit pas corrompu.
Constatation: si je fait le traitement 5 fois, le temps d'execution est rendu a 3sec X5 pour le 5ieme traitement. Ensuite si j'enregistre avant la fermeture, lorsque j'ouvre a nouveau mon application, le temps d'execution sera tout d'abord de 18 secondes, donc on reprend ou on avait laisse avant la fermeture.
On dirait qu'il y a un tableau qui est trop gros quelque part, il y a peut etre des objets non desirable dans les dernieres cellules mais je n'ai encore rien trouve.
Bonjour Capucin le forum
moi je dirais que tu as un tableau qui s'incrémente et qui s'enregistre et de ce fait, si tu augmentes tes nombres de lignes tu augmentes le traitement, sans fichier dur à te dire mais je vois bien un truc du genre.
tu recopies certainement le résultat de ton filtre et l'ajoute au lieu de le copier ailleurs????
a+
Papou
Salut Paritec, ca fait longtemps!
Merci d'avoir repondu, je suis pas mal decourage avec mon probleme. Je suis rendu a 20 heures . Ta piste a bien du bon sang, mais je ne vois pas ou j'ai un erreur. Mon probleme est dans le sub "COMPILATEUR".
Mon fichier a environ 8 Meg alors je t'envoi le code seulement.
Sub COMPILATEUR() ' Toutes les macros utilisées par la macro COMPILATEUR sont dans ce module
Application.ScreenUpdating = False
Clear_tableaux ' on efface les feuilles avant de commencer
Transfert ' Transfert le code dans le tableau vert, feuille "traitements"
ADRESSES ' Remplit le champ "adresse" du tableau vert
INSTRUCTION_DE_SAUT ' Met dans tableau jaune, les instructions de saut
EXTRACTION_LABEL ' Extrait tout les labels et leurs adresse, du tableau vert
CHAMPS_ADRESSE ' Remplit les "X" par les adresse de saut, dans le tableau jaune
TABLEAU_FINAL ' dernieres transformations de tableau, traitement des variables + transfert vers "ASS compile
Liste_Erreurs ' Color les instructions générant une erreur #N/A (Page "ASS" et Page "ASS Compile")
FormatCellules ' Elimine les bordures de cellule et met en bleu la colonne Adresses + mise en forme conditionnelle pour .ORG et les instructions en developpement (:)
Application.CommandBars(1).Enabled = True 'ces 2 lignes permettent d'eliminer la barre "vide"
Application.CommandBars(1).Enabled = False
End Sub
Sub Clear_tableaux()
With Sheets("Traitements").Range("A2:AL" & Rows.Count)
.ClearContents ' On efface la page Traitements
.Interior.ColorIndex = xlNone
End With
With Sheets("ASS Compile").Range("A3:AA" & Rows.Count)
.ClearContents ' On efface la page ASS Compile
.Interior.ColorIndex = xlNone
.NumberFormat = "@" ' Format de cellule Texte
.HorizontalAlignment = xlCenter ' Centre les données
End With
With Sheets("SEGMENT").Range("J3:AA" & Rows.Count)
.ClearContents ' Efface la feuille SEGMENT
.NumberFormat = "@" ' Format de cellule Texte
.HorizontalAlignment = xlCenter ' Centre les données
End With
With Sheets("intel HEX").Range("A3:V" & Rows.Count)
.ClearContents ' Efface la feuille intel HEX
.NumberFormat = "@" ' Format de cellule Texte
.HorizontalAlignment = xlCenter ' Centre les données
End With
Sheets("ASS").Select
End Sub
Sub Transfert() ' On est dans la feuille ASS
Dim lg As Long
lg = Range("A" & Rows.Count).End(xlUp).Row
With Sheets("traitements")
Range("A3:J" & lg).COPY destination:=.Range("A2")
.Select
End With
End Sub
Sub ADRESSES() ' On est dans la feuille Traitements
Dim lg As Long
Dim G As String
lg = Range("I" & Rows.Count).End(xlUp).Row
G = "DECHEX(HEXDEC(R[-1]C2)+COUNTA(R[-1]C3:R[-1]C6))" 'compte les cellules non vide de la ligne au dessus
With Range("B2:B" & lg)
.Formula = "=IF(ISNUMBER(FIND("".ORG"",RC9)),MID(RC9,6,4),REPT(0,4-len(" & G & "))&" & G & ")" 'formule complete pour 4 digit et gere les .org
.COPY
End With
Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'application de la formule
Range("B2:B" & lg).COPY Range("K2") 'stockage temporaire pour formule plus bas
Range("B2:B" & lg).Formula = "=IF(RC3="""","""",RC11)" 'vide la cellule si aucune valeur en RC3
Range("A1").Select
End Sub
Sub INSTRUCTION_DE_SAUT()
' On est dans la feuille Traitements
Range("A1:J1400").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("AN2:AN4"), CopyToRange:=Range("L1:U2000"), Unique:=False
End Sub
Sub EXTRACTION_LABEL()
' On est dans la feuille Traitements
Range("A1:J1400").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("AP2:AP3"), CopyToRange:=Range("Z1:AA500"), Unique:=False
End Sub
Sub CHAMPS_ADRESSE()
' On est dans la feuille Traitements
' remplit les "X" par les adresse de saut, dans le tableau jaune
Dim lg As Long
lg = Range("T" & Rows.Count).End(xlUp).Row
Range("W2:W" & lg).Formula = "=IF(ISNUMBER(FIND("","",RC20)),RIGHT(RC20,LEN(RC20)-FIND("","",RC20)),RIGHT(RC20,LEN(RC20)-FIND("" "",RC20)))"
Range("X2:X" & lg).Formula = "=VLOOKUP(RC[-1],R2C26:R300C27,2,0)"
Range("O2:O" & lg).Formula = "=MID(RC24,3,2)"
Range("P2:P" & lg).Formula = "=MID(RC24,1,2)"
'désactive les formules mis dans cette passe (les valeurs sont figées)
Range("O2:P" & lg).COPY
Range("O2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
End Sub
Sub TABLEAU_FINAL() 'dernieres transformations du tableau et traitement des variables
' On est dans la feuille Traitements
Dim lg As Long
lg = Range("I" & Rows.Count).End(xlUp).Row
'Copie le tableau vert moins les instructions de saut dans tableau rouge
Range("A1:J" & lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("AN6:AO7"), _
CopyToRange:=Range("AC1:AL" & lg), Unique:=False
' Copie du tableau Jaune à la suite du tableau Rouge
Range("L2:U" & Range("T" & Rows.Count).End(xlUp).Row).COPY destination:=Range("AC" & Rows.Count).End(xlUp).Offset(1, 0)
' Tri du tableau Rouge
lg = Range("AK" & Rows.Count).End(xlUp).Row
Range("AC2:AL" & lg).Sort Key1:=Range("AC2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
' Copie le tableau rouge dans le tableau vert
Range("AC2:AL" & lg).COPY destination:=Range("A2")
Variable_type1 'traitement des variables "R"
Variable_type2 'traitement des variables "L" et "H"
' Copie le tableau vert sur la feuille "ASS compile "
With Sheets("ASS Compile")
'On copie en 2 etape car le tableau destination possede une colonne de plus (en B)
Range("A2:A" & lg).COPY destination:=.Range("A3")
Range("B2:K" & lg).COPY destination:=.Range("C3")
.Select
Range("A2").Select
End With
'Range("C3:F" & Lg).Select
'Selection.NumberFormat = "00" 'met les cellules avec 2 chiffres. Necessaire car certaines cellule ne comporte n'ont pas de "o" en avant
End Sub
Sub Variable_type1() 'traitement de variables, pour cellules avec "R" instructions in A,( ) et OUT( ),A Papou
Dim i&, fin&, x As Variant, N$, m, cel As Range, lig&
With Feuil6
fin = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To fin
If Not IsError(.Cells(i, 4)) Then
If .Cells(i, 4) = "R" Then
x = Split(.Cells(i, 9), "(")
m = Split(x(1), ")")
N = m(0)
Set cel = Feuil7.Range("A:A").find(N, , , xlWhole)
If Not cel Is Nothing Then lig = cel.Row
.Cells(i, 4).NumberFormat = "@" ' Format texte pour cette cellule afin d' afficher le 0 a gauche, s'il y en a un!
.Cells(i, 4) = Right(Feuil7.Cells(lig, 2), 2)
.Cells(i, 4).Font.ColorIndex = 5 'met la couleur dans la cellule R
End If
End If
Next i
End With
End Sub
Sub Variable_type2() 'traitement de variables, pour cellules avec "L" suivit de "H" Papou
Dim i&, fin&, A&, x As Variant, N$, m, cel As Range, lig&
With Feuil6
fin = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To fin
For A = 4 To 5
If Not IsError(.Cells(i, A)) Then
If .Cells(i, A) = "L" Then 'on suppose que "H" est present dans la cellule de droite
If .Cells(i, 9) Like "*" & "(" & "*" Then 'si on a une parenthese
x = Split(.Cells(i, 9), "(")
m = Split(x(1), ")")
N = m(0)
Set cel = Feuil7.Range("A:A").find(N, , , xlWhole)
If Not cel Is Nothing Then lig = cel.Row
.Cells(i, A).NumberFormat = "@" ' Format texte pour cette cellule afin d' afficher le 0 a gauche, s'il y en a un!
.Cells(i, A) = Right(Feuil7.Cells(lig, 2), 2)
.Cells(i, A).Font.ColorIndex = 5 'met la couleur dans la cellule H
.Cells(i, A + 1).NumberFormat = "@"
.Cells(i, A + 1) = Left(Feuil7.Cells(lig, 2), 2)
.Cells(i, A + 1).Font.ColorIndex = 5 'met la couleur dans la cellule L
Else
x = Split(.Cells(i, 9), ",") ' on presume qu'on a une virgule
N = x(1)
Set cel = Feuil7.Range("A:A").find(N, , , xlWhole)
If Not cel Is Nothing Then lig = cel.Row
.Cells(i, A).NumberFormat = "@" ' Format texte pour cette cellule afin d' afficher le 0 a gauche, s'il y en a un!
.Cells(i, A) = Right(Feuil7.Cells(lig, 2), 2)
.Cells(i, A).Font.ColorIndex = 5 'met la couleur dans la cellule H
.Cells(i, A + 1).NumberFormat = "@"
.Cells(i, A + 1) = Left(Feuil7.Cells(lig, 2), 2)
.Cells(i, A + 1).Font.ColorIndex = 5 'met la couleur dans la cellule L
End If
End If
End If
Next A
Next i
End With
End Sub
Sub Liste_Erreurs()
' On est dans la feuille ASS Compile pour debuter
' Pour toute les cellules de colonne J en erreur sur feuille "ass compile" , on couleur la cellule sur les 2 feuilles.
Dim Plage As Range
Dim cel As Range
Dim cumulatif
' Enlève la couleur de fond colonne J dans la page ASS Compile
Range("J3:J" & Range("J" & Rows.Count).End(xlUp).Row).Interior.ColorIndex = xlNone
' Enlève la couleur de fond colonne I dans la page ASS
Sheets("ASS").Range("I3:I" & Sheets("ASS").Range("I" & Rows.Count).End(xlUp).Row).Interior.ColorIndex = xlNone
cumulatif = 0 'compte le nbre d'erreurs de lien
On Error Resume Next ' Au cas ou pas de cellules correspondantes
Set Plage = Columns(4).SpecialCells(xlCellTypeConstants, xlErrors)
On Error GoTo 0 ' Rétablit la gestions des erreurs
If Not Plage Is Nothing Then ' Des cellules ?
For Each cel In Plage ' Si Oui pour chaque cellule
cel.Offset(0, 5).Interior.ColorIndex = 4 ' Dans la page ASS Compile
Sheets("ASS").Range(cel.Address).Offset(0, 5).Interior.ColorIndex = 4 ' Dans la page ASS
cumulatif = cumulatif + 1 'nbre d'erreurs
Next cel
MsgBox (cumulatif & " erreur(s) trouve(s)")
End If
End Sub
Sub FormatCellules()
Range("D3:G10000").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
Range("C3:C3037").Select
Selection.Font.ColorIndex = 5 'ADRESSE EN BLEU
'On ajoute une mise en forme conditionelle:
Columns("J:J").Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=GAUCHE(J1;4)="".ORG"""
.FormatConditions(1).Font.ColorIndex = 3 'ROUGE
.FormatConditions.Add Type:=xlExpression, Formula1:="=GAUCHE(J1;1)="":"""
.FormatConditions(2).Font.ColorIndex = 10 'VERT
End With
Range("J3").Select
End Subj'ai effectue d'autres test et apres avoir enleve screen updating = false, je m'apercoit que tout les filtres elabores sont tres lent d'execution, on voit les lignes apparaitre une a la fois. Les parametres pour mes filtres semblent bon: tableau source, tableau destination et criteres. Les versions precedentes fonctionnait tres rapidement et il me semble que je n'ai pas modifie rien de ce qui concerne mes filtres dans la derniere version.
Crois-tu que je pourrais t'envoyer mon fichier, environ 7 Meg (800K compresse), si tu as le temps bien sur?
Probleme resolu. Beaucoup de parasites dans mon fichier excel. Amelioration du code pour une vitesse accrue.
Merci Paritec (Papou)