Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Ecriture lente de données (tableau dans une boucle)

Ecriture lente de données (tableau dans une boucle)

11 réponses
Avatar
JP
Bonjour,
Je ne m'explique pas la lenteur de cette macro.
J'ai pourtant essay=E9 en t=EAte de code:

Application.Calculation =3D xlCalculationManual
Application.EnableEvents =3D False
Application.ScreenUpdating =3D False

Voici la partie qui prend beaucoup de temps. Tout ce qui pr=E9c=E8de met en=
viron 1/2 seconde et la boucle en question prend 7 secondes pour 70 lignes =
et 7 colonnes.
entre Start=3Dtimer et MsgBox "dur=E9e du traitement: " & (Timer - start) /=
1000 & " secondes", il s'=E9coule plus de 7 secondes en moyenne.


start =3D timer

'ecriture des adresses

For i =3D 0 To DerniereAdresse - 1 ' dans le cas pr=E9sent, 70
Sheets("pfmp").Cells(3, i + 9) =3D Tab_adresse(i, 0) & vbCrLf _
& Tab_adresse(i, 1) & vbCrLf _
& Tab_adresse(i, 2) & vbCrLf _
& Tab_adresse(i, 3) & " " & Tab_adresse(i, 4) & vbCrLf _
& "T=E9l: " & Tab_adresse(i, 5) & " - " & "Fax: " & Tab_adresse(i, =
6)
Next i

MsgBox "dur=E9e du traitement: " & (Timer - start) / 1000 & " secondes"


Merci pour les id=E9es

JP
Signaler un problème avec ce contenu

10 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
Avatar
MichD
Bonjour,

Quand tu poses une question comme celle-là, n'oublie pas de définir
tes variables....


Essaie comme ceci :
Si tu veux de la performance dans une procédure, il faut d'abord débuter
par la déclaration des variables et de leur type!

'---------------------------------------------------
Sub test()

Dim DerniereAdresse As Long, T(), i As Long
Dim Tab_adresse As Range
Dim DerniereAdresse()

Tab_adresse 'à définir

DerniereAdresse = 6

DerniereAdresse = DerniereAdresse - 1
ReDim T(1 To DerniereAdresse)

For i = 0 To DerniereAdresse
T(i) = Tab_adresse(i, 0) & vbCrLf _
& Tab_adresse(i, 1) & vbCrLf _
& Tab_adresse(i, 2) & vbCrLf _
& Tab_adresse(i, 3) & " " & Tab_adresse(i, 4) & vbCrLf _
& "Tél: " & Tab_adresse(i, 5) & " - " & "Fax: " & Tab_adresse(i,
5)
Next

Application.EnableEvents = False
Application.ScreenUpdating = False

With Sheets("Feuil1") 'Nom feuille à adapter
.Cells(3, 9).Resize(UBound(T)) = Application.Transpose(T)
.Cells(3, 9).Resize(UBound(T)).EntireRow.AutoFit
End With
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
'------------------------------------------------
Avatar
MichD
Plutôt ceci :


Sub test()

Dim DerniereAdresse As Long, T(), i As Long
Dim Tab_adresse()

'Tab_adresse à définir!

DerniereAdresse = 6

DerniereAdresse = DerniereAdresse - 1
ReDim T(0 To DerniereAdresse)

For i = 0 To DerniereAdresse
T(i) = Tab_adresse(i, 0) & vbCrLf _
& Tab_adresse(i, 1) & vbCrLf _
& Tab_adresse(i, 2) & vbCrLf _
& Tab_adresse(i, 3) & " " & Tab_adresse(i, 4) & vbCrLf _
& "Tél: " & Tab_adresse(i, 5) & " - " & "Fax: " & Tab_adresse(i,
5)
Next

Application.EnableEvents = False
Application.ScreenUpdating = False

'Copie le contenu du tableau dans une feuille de calcul
With Sheets("Feuil1")
.Cells(3, 9).Resize(UBound(T)) = Application.Transpose(T)
.Cells(3, 9).Resize(UBound(T)).EntireRow.AutoFit
End With
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
Avatar
JP
Bonjour Denis,

J'avais effectivement déclaré les variables mais je ne les ai pas trans mises. j'ai fait ce matin un copier/coller de la partie qui me semblait p écher.


Je viens de modifier le code avec ta proposition. J'ai une erreur d'executi on 9 (indice n'appartient pas à la selection)

Le code complet:

Option Explicit
Sub copyEntreprise()
'déclaration des variables
Dim start As Variant
Dim t()
Dim Tab_adresse()
Dim i As Long
Dim DerniereAdresse As Long 'integer

Sheets("parametrage").Select 'FEUILLE OU SONT LES DONNEES

'compte le nombre d'adresse
DerniereAdresse = Application.CountA(Range("T5:T194")) 'DONNE LE NB D'ADR ESSE A TRAITER 70 EN L'OCCURENCE

DerniereAdresse = DerniereAdresse - 1 ' ajouté MDenis

'redimensionne le tableau
ReDim t(0 To DerniereAdresse)

'Ecriture des adresses dans le tableau
'-------------------------
For i = 0 To DerniereAdresse
t(i) = Tab_adresse(i, 0) & vbCrLf _
& Tab_adresse(i, 1) & vbCrLf _
& Tab_adresse(i, 2) & vbCrLf _
& Tab_adresse(i, 3) & " " & Tab_adresse(i, 4) & vbCrLf _
& "Tél: " & Tab_adresse(i, 5) & " - " & "Fax: " & Tab_adresse (i, 5)
Next i
'------------------------------

'efface les données
Sheets("pfmp").Range("I3:GP3").ClearContents

'ecriture des adresses
start = Timer
'-------------------------
'Copie le contenu du tableau dans une feuille de calcul
With Sheets("pfmp")' feuille pour écrire les données sur la ligne 3 col onne 9
.Cells(3, 9).Resize(UBound(t)) = Application.Transpose(t)
.Cells(3, 9).Resize(UBound(t)).EntireRow.AutoFit
End With
'------------------


MsgBox "durée du traitement: " & (Timer - start) / 1000 & " secondes"

End Sub


Merci

JP
Avatar
MichD
Sub copyEntreprise()
'déclaration des variables

Dim T()
Dim Tab_adresse()
Dim i As Long
Dim DerniereAdresse As Long 'integer
Dim Start As Double


'ecriture des adresses
Start = Timer

Application.ScreenUpdating = False
Application.EnableEvents = False

With Sheets("parametrage") 'FEUILLE OU SONT LES DONNEES
'compte le nombre d'adresse
DerniereAdresse = .Range("T5:T194").Cells.Count 'DONNE LE NB D'ADRESSE A
TRAITER 70 EN L'OCCURENCE

'Je suppose que tu veux placer dans un tableau les données
'de la plage T5:Zx dans un tableau "Tab_adresse"
Tab_adresse = .Range("T5").Resize(DerniereAdresse, 7).Value
'redimensionne le tableau
ReDim T(1 To DerniereAdresse)
End With

'Ecriture des adresses dans le tableau
'-------------------------
For i = 1 To DerniereAdresse
T(i) = Tab_adresse(i, 1) & vbCrLf _
& Tab_adresse(i, 2) & vbCrLf _
& Tab_adresse(i, 3) & vbCrLf _
& Tab_adresse(i, 3) & " " & Tab_adresse(i, 5) & vbCrLf _
& "Tél: " & Tab_adresse(i, 6) & " - " & "Fax: " & Tab_adresse(i,
7)
Next i
'------------------------------

'efface les données
Sheets("pfmp").Range("I3:GP3").ClearContents

'-------------------------
'Copie le contenu du tableau dans une feuille de calcul
With Sheets("pfmp") ' feuille pour écrire les données sur la ligne 3 colonne
9
.Cells(3, 9).Resize(UBound(T)) = Application.Transpose(T)
.Cells(3, 9).Resize(UBound(T)).EntireRow.AutoFit
End With
'------------------

Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "durée du traitement: " & (Timer - Start) / 1000 & " secondes"
End Sub
Avatar
JP
Denis,

Regarde l'exemple en PJ.
http://cjoint.com/?DAxu6dMBHMI

L'écriture se fait en verticale?
Transpose devrait faire une écriture sur une ligne et ce n'est pas le cas .
Que faut-il changer?

Merci

JP
Avatar
MichD
C'est quoi ton problème?

Dans ton fichier, tu as la plage "A5:A194", quel résultat veux-tu obtenir?

Je ne vais pas passer la semaine sur 3 lignes de code...

À moins que tu n'expliques clairement ce que tu veux, moi j'abdique!
Avatar
JP
Désolé, je voudrai que les données s'écrivent sur la ligne 3 (en ho rizontale).
de la colonne 9 à (jusqu'à ce que le nombre d'entreprise soit épuis é)

JP
Avatar
MichD
Sub copyEntreprise()

'déclaration des variables
Dim T()
Dim Tab_adresse()
Dim i As Long
Dim DerniereAdresse As Long 'integer

Dim Start As Double


'ecriture des adresses
Start = Timer

Application.ScreenUpdating = False
Application.EnableEvents = False

With Sheets("feuil1")
'compte le nombre d'adresse

DerniereAdresse = .Range("A5:A194").Cells.Count 'DONNE LE NB D'ADRESSE A
TRAITER 70 EN L'OCCURENCE

'Je suppose que tu veux placer dans un tableau les données
'de la plage T5:Zx dans un tableau "Tab_adresse"
Tab_adresse = .Range("A5").Resize(DerniereAdresse, 7).Value
'redimensionne le tableau
ReDim T(1 To DerniereAdresse)
End With


'Ecriture des adresses dans le tableau
'-------------------------

For i = 1 To DerniereAdresse
T(i) = Tab_adresse(i, 1) & Chr(10) _
& Tab_adresse(i, 2) & Chr(10) _
& Tab_adresse(i, 3) & Chr(10) _
& Tab_adresse(i, 3) & " " & Tab_adresse(i, 5) & Chr(10) _
& "Tél: " & Tab_adresse(i, 6) & " - " & "Fax: " & Tab_adresse(i,
7)
' MsgBox T(i)
Next i
'------------------------------

'efface les données
Sheets("Feuil1").Range("I3:GP3").ClearContents
'-------------------------
'Copie le contenu du tableau dans une feuille de calcul

With Sheets("feuil1") ' feuille pour écrire les données sur la ligne 3
colonne 9
.Cells(3, 9).Resize(UBound(T)) = Application.Transpose(T)
.Cells(3, 9).Resize(UBound(T)).EntireRow.AutoFit
.Cells(3, 9).Resize(UBound(T)).EntireColumn.AutoFit
End With

Application.ScreenUpdating = True
Application.EnableEvents = True


MsgBox "durée du traitement: " & (Timer - Start) / 1000 & " secondes"
End Sub
Avatar
JP
Denis,

Je n'ai pas ton niveau et j'en suis bien conscient. C'est pour ça que je fréquente ce forum.
Il est cependant inutile de montrer un énervement face à mon problèm e.

En PJ ce que je voulais obtenir. http://cjoint.com/?DAxwupTmB8L

La modification que tu me proposes ne fait pas ce que j'attends.

Merci pour ton aide.

JP
Avatar
MichD
Option Explicit
Sub copyEntreprise()

'déclaration des variables
Dim T()
Dim Tab_adresse()
Dim i As Long
Dim DerniereAdresse As Long 'integer

Dim Start As Double


'ecriture des adresses
Start = Timer

Application.ScreenUpdating = False
Application.EnableEvents = False


With Sheets("feuil1")

'compte le nombre d'adresse


DerniereAdresse = .Range("A5:A194").Cells.Count 'DONNE LE NB D'ADRESSE A
TRAITER 70 EN L'OCCURENCE

'Je suppose que tu veux placer dans un tableau les données
'de la plage T5:Zx dans un tableau "Tab_adresse"
Tab_adresse = .Range("A5").Resize(DerniereAdresse, 7).Value
'redimensionne le tableau
ReDim T(1 To DerniereAdresse)
End With


'Ecriture des adresses dans le tableau
'-------------------------

For i = 1 To DerniereAdresse

T(i) = Tab_adresse(i, 1) & Chr(10) _
& Tab_adresse(i, 2) & Chr(10) _
& Tab_adresse(i, 3) & Chr(10) _
& Tab_adresse(i, 3) & " " & Tab_adresse(i, 5) & Chr(10) _
& "Tél: " & Tab_adresse(i, 6) & " - " & Chr(10) & _
"Fax: " & Tab_adresse(i, 7)

' MsgBox T(i)

Next i
'------------------------------

'efface les données

Sheets("Feuil1").Range("I3:GP3").ClearContents

'-------------------------
'Copie le contenu du tableau dans une feuille de calcul


With Sheets("feuil1") ' feuille pour écrire les données sur la ligne 3
colonne 9
.Cells(3, 9).Resize(, UBound(T)) = T
.Cells(3, 9).Resize(, UBound(T)).Orientation = 90
.Cells(3, 9).Resize(, UBound(T)).WrapText = True
.Cells(3, 9).Resize(, UBound(T)).EntireRow.AutoFit
.Cells(3, 9).Resize(, UBound(T)).EntireColumn.AutoFit
End With
1 2