Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel temps éxécution macro trop long

temps éxécution macro trop long

23 réponses
Avatar
Caroual
Bonjour,
J'aurais aimé avoir un peu d'aide pour améliorer mon code.
J'ai un fichier texte sur 12000 lignes et 16 colonnes. Dans excel je
voudrais mettre 5 lignes sur une seule ligne et supprimer les lignes qui ont
été recopiées.
J'ai écrit ce code qui marche mais cela me semble anormalement long. (2
minutes d'éxécution)


Sub essai()
Application.ScreenUpdating = False
tata = Application.GetOpenFilename
Workbooks.OpenText Filename:=tata, Origin:=xlMSDOS, StartRow:=1,
DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(4, 1), Array(10, 1), Array(16, 1), Array(22,
1), Array(28, 1), _
Array(34, 1), Array(40, 1), Array(46, 1), Array(52, 1), Array(58, 1),
Array(64, 1), Array( _
70, 1), Array(76, 1), Array(82, 1), Array(88, 1), Array(94, 1)),
TrailingMinusNumbers _
:=True
fin = Range("a35000").End(xlUp)
Range("a1").Select
For k = 1 To fin
For n = 2 To 5
Cells(k, 1).Select
Range(Cells(n + k - 1, 2), Cells(n + k - 1, 16)).Copy
Cells(k, 200).End(xlToLeft).Offset(, 1).PasteSpecial
Paste:=xlPasteValues
Next
Range(Cells(k + 1, 1), Cells(k + 4, 18)).Delete
Next
End Sub

J'avais désactivé les calculs auto mais il n'y a aucune formule dans ce
fichier donc cela ne doit servir à rien.
Peut être est-ce normal. J'aimerais votre un avis.
Merci
Caroual
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3
Avatar
Misange
isabelle a écrit :
salutatous,

j'ai fais le test avec (excel2002) 20000 lignes et j'obtiens à peu
près le même résultat soit 73.140999999999 secondes.
et en mode automatique, si je met la commande Application.Calculation =
xlCalculationManual mit en commentaire
le résultat est 78.795999999998 secondes.



Résultats avec excel 2007 sp2 et 2 GO de mémoire;
16000 lignes et 16 colonnes = plantage en manuel, quoi que je fasse mais
avec 5000 ça passe et le fait d'activer ou pas la vidange du presse
papier n'y change que couic

en auto 19.3 secondes sans vider le presse papier
20.12 en utilisant clear_clipboard
21.02 avec ta méthode

Sub Clear_Clipboard()
Dim truc As DataObject

Set truc = New DataObject
truc.SetText ""
truc.PutInClipboard

Set truc = Nothing
End Sub

donc clairement chez moi avec 2007, le problème ne vient pas du presse
papier :-(

--
Misange migrateuse
http://www.excelabo.net : Participez à un travail collaboratif sur excel !
Avatar
Caroual
Merci pour ce code qui va bien (30 secondes au lieu de 2 minutes à ma façon)
Pour ce qui est de la conversion txt vers excel je l'ai fait en
enregistrement et je ne me suis pas posé de question. Cela prend peut-être
en compte des colones vides. Le fichier original (qui n'a aucune extension)
provient d'une très vieille application qui tourne sous Unix.

Merci beaucoup en tout cas car cela me convient très bien.
Et merci à tous ceux qui se sont penchés sur mon problème.
Caroual


"Mgr T. Banni" a écrit dans le message de news:
%
le voici, caroual
HTH
Mgr T.B.

"MichDenis" a écrit dans le message de news:

J'ai fait un petit test,

Pour traiter 20,000 lignes, environ 16 secondes.

De la macro originale, il faut enlever ces lignes de code :

ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.Calculation = ModCalcul

La version de la procédure suivante est corrigé.
Une question demeure: Si ton tableau à 16 colonnes (champ)
comment arrives-tu à ces array(46,1), array(70,1)...etc.
Le premier chiffre indique le numéro du champ, le deuxième
numéro de l'array indique le format du champ ?



'------------------------------------------------
Sub test()
Dim Fin As Long, K As Long, L As Long
Dim A As Integer, Lig As Long
Dim Source As Worksheet, Dest As Worksheet, N As String
Dim Fichier As Variant, Wk As Workbook

Application.ScreenUpdating = False
Application.Calculation =xlCalculationAutomatic
Application.EnableEvents = False

Fichier = Application.GetOpenFilename
If TypeName(Fichier) = "Boolean" Then Exit Sub
If LCase(Right(Fichier, 4)) <> ".txt" Then
MsgBox "Opération annulée, ce n'est pas un fichier texte"
Exit Sub
End If

Workbooks.OpenText Filename:=Fichier, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(4, 1), _
Array(10, 1), Array(16, 1), Array(22, 1), Array(28, 1), _
Array(34, 1), Array(40, 1), Array(46, 1), Array(52, 1), _
Array(58, 1), Array(64, 1), Array(70, 1), Array(76, 1), _
Array(82, 1), Array(88, 1), Array(94, 1)), _
TrailingMinusNumbers:=True

Set Wk = ActiveWorkbook

With Wk
Set Source = Wk.ActiveSheet
Set Dest = Wk.Worksheets.Add
End With

Fin = Source.Range("A65000").End(xlUp).Row
A = 1
For K = 1 To Fin Step 5
L = K + 4
Lig = Lig + 1
For X = K To L
Source.Range("A" & X).Resize(, 16).Cut Dest.Cells(Lig, A)
A = A + 16
Next
A = 1
Next
Application.DisplayAlerts = False
N = Source.Name
Source.Delete
Dest.Name = N
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
'------------------------------------------------






"Caroual" a écrit dans le message de groupe de
discussion : 49f7f6ed$0$12629$
Bonjour,
J'aurais aimé avoir un peu d'aide pour améliorer mon code.
J'ai un fichier texte sur 12000 lignes et 16 colonnes. Dans excel je
voudrais mettre 5 lignes sur une seule ligne et supprimer les lignes qui
ont
été recopiées.
J'ai écrit ce code qui marche mais cela me semble anormalement long. (2
minutes d'éxécution)


Sub essai()
Application.ScreenUpdating = False
tata = Application.GetOpenFilename
Workbooks.OpenText Filename:=tata, Origin:=xlMSDOS, StartRow:=1,
DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(4, 1), Array(10, 1), Array(16, 1), Array(22,
1), Array(28, 1), _
Array(34, 1), Array(40, 1), Array(46, 1), Array(52, 1), Array(58, 1),
Array(64, 1), Array( _
70, 1), Array(76, 1), Array(82, 1), Array(88, 1), Array(94, 1)),
TrailingMinusNumbers _
:=True
fin = Range("a35000").End(xlUp)
Range("a1").Select
For k = 1 To fin
For n = 2 To 5
Cells(k, 1).Select
Range(Cells(n + k - 1, 2), Cells(n + k - 1, 16)).Copy
Cells(k, 200).End(xlToLeft).Offset(, 1).PasteSpecial
Paste:=xlPasteValues
Next
Range(Cells(k + 1, 1), Cells(k + 4, 18)).Delete
Next
End Sub

J'avais désactivé les calculs auto mais il n'y a aucune formule dans ce
fichier donc cela ne doit servir à rien.
Peut être est-ce normal. J'aimerais votre un avis.
Merci
Caroual






Avatar
Caroual
Désolée de ne pas avoir lu tes messages plus tôt mais j'étais sur les news
d'Orange et dans ces news chez moi, tu n'apparais pas.
Depuis je me suis mise sur les news de microsoft et là je vois tous tes
messages. J'ai testé le dernier de ce matin et mon fichier se traite
maintenant en moins de 2 secondes.
Incroyable....
Bravo et merci à toi et à tous les autres

Caroual

"MichDenis" a écrit dans le message de news:

Si cela t'intéresse, tu as une nouvelle version.

Pour transformer 20,000 de 16 colonnes en
4000 de 80 colonnes : durée : moins de 2.6 secondes sur mon ordi
tu devrais obtenir un temps de moins de 5 secondes.

Certaines lignes de code ont été désactivées pour un test de performance
Il ne te reste plus qu'à les activer.

'--------------------------------------------------------
Sub Mode_Calcul_Automatique()
Dim Fin As Long, K As Long, L As Long
Dim A As Integer, Lig As Long, ModCalcul As String
Dim Source As Worksheet, Dest As Worksheet, N As String
Dim Fichier As Variant, Wk As Workbook
Dim T As Double, Durée As Double
Durée = Timer

'Ligne désactiver pour les besoins d'un test de vitesse
'Application.EnableEvents = False
'Fichier = Application.GetOpenFilename
'If TypeName(Fichier) = "Boolean" Then Exit Sub
'If LCase(Right(Fichier, 4)) <> ".txt" Then
' MsgBox "Opération annulée, ce n'est pas un fichier texte"
' Exit Sub
'End If

'Workbooks.OpenText Filename:=Fichier, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, _
TrailingMinusNumbers:=True

ModCalcul = Application.Calculation
Application.Calculation = xlCalculationAutomatic
With ActiveSheet
DerLig = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
DerCol = .Cells.Find("*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
D = .Range(.Range("A1"), .Cells(DerLig, DerCol))
ReDim M(1 To Application.Ceiling(DerLig / 5, 1), 1 To DerCol * 5)

For K = 1 To UBound(D, 1)
T = T + 1
L = K + 4
C = 0
For X = K To L
For B = 1 To UBound(D, 2)
C = C + 1
M(T, C) = D(X, B)
Next
Next
K = K + 4
Next
.Range(.Range("A1"), .Cells(DerLig, DerCol)).Clear
.Range("A1").Resize(UBound(M, 1), UBound(M, 2)).Value = M
.UsedRange.EntireColumn.AutoFit
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
MsgBox Timer - Durée

End Sub
'--------------------------------------------------------




"Caroual" a écrit dans le message de groupe de
discussion : 49fa6a72$0$12653$
Merci pour ce code qui va bien (30 secondes au lieu de 2 minutes à ma
façon)
Pour ce qui est de la conversion txt vers excel je l'ai fait en
enregistrement et je ne me suis pas posé de question. Cela prend peut-être
en compte des colones vides. Le fichier original (qui n'a aucune
extension)
provient d'une très vieille application qui tourne sous Unix.

Merci beaucoup en tout cas car cela me convient très bien.
Et merci à tous ceux qui se sont penchés sur mon problème.
Caroual


"Mgr T. Banni" a écrit dans le message de news:
%
le voici, caroual
HTH
Mgr T.B.

"MichDenis" a écrit dans le message de news:

J'ai fait un petit test,

Pour traiter 20,000 lignes, environ 16 secondes.

De la macro originale, il faut enlever ces lignes de code :

ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.Calculation = ModCalcul

La version de la procédure suivante est corrigé.
Une question demeure: Si ton tableau à 16 colonnes (champ)
comment arrives-tu à ces array(46,1), array(70,1)...etc.
Le premier chiffre indique le numéro du champ, le deuxième
numéro de l'array indique le format du champ ?



'------------------------------------------------
Sub test()
Dim Fin As Long, K As Long, L As Long
Dim A As Integer, Lig As Long
Dim Source As Worksheet, Dest As Worksheet, N As String
Dim Fichier As Variant, Wk As Workbook

Application.ScreenUpdating = False
Application.Calculation =xlCalculationAutomatic
Application.EnableEvents = False

Fichier = Application.GetOpenFilename
If TypeName(Fichier) = "Boolean" Then Exit Sub
If LCase(Right(Fichier, 4)) <> ".txt" Then
MsgBox "Opération annulée, ce n'est pas un fichier texte"
Exit Sub
End If

Workbooks.OpenText Filename:=Fichier, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(4, 1), _
Array(10, 1), Array(16, 1), Array(22, 1), Array(28, 1), _
Array(34, 1), Array(40, 1), Array(46, 1), Array(52, 1), _
Array(58, 1), Array(64, 1), Array(70, 1), Array(76, 1), _
Array(82, 1), Array(88, 1), Array(94, 1)), _
TrailingMinusNumbers:=True

Set Wk = ActiveWorkbook

With Wk
Set Source = Wk.ActiveSheet
Set Dest = Wk.Worksheets.Add
End With

Fin = Source.Range("A65000").End(xlUp).Row
A = 1
For K = 1 To Fin Step 5
L = K + 4
Lig = Lig + 1
For X = K To L
Source.Range("A" & X).Resize(, 16).Cut Dest.Cells(Lig, A)
A = A + 16
Next
A = 1
Next
Application.DisplayAlerts = False
N = Source.Name
Source.Delete
Dest.Name = N
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
'------------------------------------------------






"Caroual" a écrit dans le message de groupe de
discussion : 49f7f6ed$0$12629$
Bonjour,
J'aurais aimé avoir un peu d'aide pour améliorer mon code.
J'ai un fichier texte sur 12000 lignes et 16 colonnes. Dans excel je
voudrais mettre 5 lignes sur une seule ligne et supprimer les lignes qui
ont
été recopiées.
J'ai écrit ce code qui marche mais cela me semble anormalement long. (2
minutes d'éxécution)


Sub essai()
Application.ScreenUpdating = False
tata = Application.GetOpenFilename
Workbooks.OpenText Filename:=tata, Origin:=xlMSDOS, StartRow:=1,
DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(4, 1), Array(10, 1), Array(16, 1), Array(22,
1), Array(28, 1), _
Array(34, 1), Array(40, 1), Array(46, 1), Array(52, 1), Array(58, 1),
Array(64, 1), Array( _
70, 1), Array(76, 1), Array(82, 1), Array(88, 1), Array(94, 1)),
TrailingMinusNumbers _
:=True
fin = Range("a35000").End(xlUp)
Range("a1").Select
For k = 1 To fin
For n = 2 To 5
Cells(k, 1).Select
Range(Cells(n + k - 1, 2), Cells(n + k - 1, 16)).Copy
Cells(k, 200).End(xlToLeft).Offset(, 1).PasteSpecial
Paste:=xlPasteValues
Next
Range(Cells(k + 1, 1), Cells(k + 4, 18)).Delete
Next
End Sub

J'avais désactivé les calculs auto mais il n'y a aucune formule dans ce
fichier donc cela ne doit servir à rien.
Peut être est-ce normal. J'aimerais votre un avis.
Merci
Caroual








1 2 3