Exécution lente !

Le
LANIMAL
Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !

La procédure suivante est utilisée pour changer la présentation d'un
tableau (téléchargé).

Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"

Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)

L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
LSteph
Le #20393761
Bonjour,

Manque le début et la fin , si le pb est sensé venir du code!

Cordialement

--
lSteph



On 21 oct, 14:19, LANIMAL
Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !

La procédure suivante est utilisée pour changer la présentation d'u n
tableau (téléchargé).

     Range("A" & PremLigne & ":H" & DerLign).UnMerge
     Range("A" & PremLigne + 1) = "Traité / Réglé le :"
     Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
     Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
     Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"

     Range("A" & PremLigne + 2) = "Totaux du décompte :"
     Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
     Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
     Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)

L'exécution est lente.
L'instruction Application.SreenUpdating = False  ne change rien.
Y aurait-il une autre méthode ?
Merci


LANIMAL
Le #20395091
Merci de ton attention,
Voilà, je te mets tout.
La suppression des dr est quasi instantanée,
Ce sont les écritures et Copier-Coller qui sont lents.
Il y a des formules dépendantes dans d'autres feuilles,
peut-être est-ce la cause.
J'ai essayé : " Application.Calculation = False "
Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.
Merci


Sub Reformat_Réunica()

If Selection.Columns.Count <> 5 Then Exit Sub

PremLigne = Selection.Row
DerLign = Range("A20000").End(xlUp).Row


For Each dr In ActiveSheet.Shapes 'Ajouter +1 à Derlign car le
dernier objet a le pied dans Derlign+1
If Not Intersect(dr.TopLeftCell, Range("A" & PremLigne & ":H" &
DerLign + 1)) Is Nothing _
And Not Intersect(dr.BottomRightCell, Range("A" & PremLigne &
":H" & DerLign + 1)) Is Nothing Then dr.Delete
Next

'====Re-écriture du tableau
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1 & ":C" & PremLigne + 1).NumberFormat =
"dd/mm/yy"

Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
Range("A" & PremLigne + 1 & ":A" & PremLigne +
2).HorizontalAlignment = xlRight

'====Suppression 11 lignes devenues inutiles
Rows(PremLigne + 3 & ":" & PremLigne + 13).Select
Selection.Delete
DerLign = Range("A20000").End(xlUp).Row

'====Tri des lignes de données et comptage de leur nombre
For L = DerLign To PremLigne Step -1
If Range("A" & L) = "" Then Rows(L).Delete
Next

'====Formatage des nombres
Range("A" & PremLigne + 2 & ":F" & DerLign).Select
Selection.Replace What:=",", Replacement:="."
Selection.NumberFormat = "0.00"
Selection.Replace What:=" - Remboursés par REUNICA PREVOYANCE",
Replacement:=""

'====Format 1ère ligne et collage des formules colonnes I, J, K
For L = PremLigne - 1 To PremLigne - 100 Step -1
If Left(Range("A" & L), 6) = "Détail" Then Exit For
Next
LignModeleTitre = L
Rows(LignModeleTitre).Copy
Rows(PremLigne).PasteSpecial Paste:=xlFormats
Range("I" & LignModeleTitre & ":K" & LignModeleTitre).Copy
Destination:=Range("I" & PremLigne & ":K" & PremLigne)

'====Copie-Collage des formules des autres lignes
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy
Range("G" & PremLigne + 3 & ":G" & DerLign).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range("G" & PremLigne + 3).Select

End Sub



LSteph a écrit :
Bonjour,

Manque le début et la fin , si le pb est sensé venir du code!

Cordialement

--
lSteph



On 21 oct, 14:19, LANIMAL
Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !

La procédure suivante est utilisée pour changer la présentation d'un
tableau (téléchargé).

Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"

Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)

L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci





Jacky
Le #20395371
Bonsoir,
Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.


'Au début de macro
Application.Calculation = xlCalculationManual
'et a la fin
Application.Calculation = xlCalculationAutomatic

Essaie aussi de supprimer les "select "
Exemple, ceci
'------------
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy
Range("G" & PremLigne + 3 & ":G" & DerLign).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
'--------------
'*******Donne
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy Range("G" & PremLigne + 3 & ":G" &
DerLign)
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
'--------------
Ps: pas testé si la plage de collage est correcte "Range("G" & PremLigne +
3 & ":G" & DerLign)"
--
Salutations
JJ


"LANIMAL"
Merci de ton attention,
Voilà, je te mets tout.
La suppression des dr est quasi instantanée,
Ce sont les écritures et Copier-Coller qui sont lents.
Il y a des formules dépendantes dans d'autres feuilles,
peut-être est-ce la cause.
J'ai essayé : " Application.Calculation = False "
Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.
Merci


Sub Reformat_Réunica()

If Selection.Columns.Count <> 5 Then Exit Sub

PremLigne = Selection.Row
DerLign = Range("A20000").End(xlUp).Row


For Each dr In ActiveSheet.Shapes 'Ajouter +1 à Derlign car le
dernier objet a le pied dans Derlign+1
If Not Intersect(dr.TopLeftCell, Range("A" & PremLigne & ":H" &
DerLign + 1)) Is Nothing _
And Not Intersect(dr.BottomRightCell, Range("A" & PremLigne & ":H"
& DerLign + 1)) Is Nothing Then dr.Delete
Next

'====Re-écriture du tableau
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1 & ":C" & PremLigne + 1).NumberFormat =
"dd/mm/yy"

Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
Range("A" & PremLigne + 1 & ":A" & PremLigne + 2).HorizontalAlignment
= xlRight

'====Suppression 11 lignes devenues inutiles
Rows(PremLigne + 3 & ":" & PremLigne + 13).Select
Selection.Delete
DerLign = Range("A20000").End(xlUp).Row

'====Tri des lignes de données et comptage de leur nombre
For L = DerLign To PremLigne Step -1
If Range("A" & L) = "" Then Rows(L).Delete
Next

'====Formatage des nombres
Range("A" & PremLigne + 2 & ":F" & DerLign).Select
Selection.Replace What:=",", Replacement:="."
Selection.NumberFormat = "0.00"
Selection.Replace What:=" - Remboursés par REUNICA PREVOYANCE",
Replacement:=""

'====Format 1ère ligne et collage des formules colonnes I, J, K
For L = PremLigne - 1 To PremLigne - 100 Step -1
If Left(Range("A" & L), 6) = "Détail" Then Exit For
Next
LignModeleTitre = L
Rows(LignModeleTitre).Copy
Rows(PremLigne).PasteSpecial Paste:=xlFormats
Range("I" & LignModeleTitre & ":K" & LignModeleTitre).Copy
Destination:=Range("I" & PremLigne & ":K" & PremLigne)

'====Copie-Collage des formules des autres lignes
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy
Range("G" & PremLigne + 3 & ":G" & DerLign).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range("G" & PremLigne + 3).Select

End Sub



LSteph a écrit :
Bonjour,

Manque le début et la fin , si le pb est sensé venir du code!

Cordialement

--
lSteph



On 21 oct, 14:19, LANIMAL
Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !

La procédure suivante est utilisée pour changer la présentation d'un
tableau (téléchargé).

Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"

Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)

L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci







LANIMAL
Le #20395851
Merci Jacky, super... et très rapide !
Ok pour les "Select", en général je les mets pour les 1ers contrôles de
la procédure en pas à pas.
Merci

Jacky a écrit :
Bonsoir,
Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.


'Au début de macro
Application.Calculation = xlCalculationManual
'et a la fin
Application.Calculation = xlCalculationAutomatic

Essaie aussi de supprimer les "select "
Exemple, ceci
'------------
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy
Range("G" & PremLigne + 3 & ":G" & DerLign).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
'--------------
'*******Donne
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy Range("G" & PremLigne + 3 & ":G" &
DerLign)
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
'--------------
Ps: pas testé si la plage de collage est correcte "Range("G" & PremLigne +
3 & ":G" & DerLign)"


Publicité
Poster une réponse
Anonyme