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

Le
JP
Bonjour,
Je ne m'explique pas la lenteur de cette macro.
J'ai pourtant essayé en tête de code:

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

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


start = timer

'ecriture des adresses

For i = 0 To DerniereAdresse - 1 ' dans le cas présent, 70
Sheets("pfmp").Cells(3, i + 9) = 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, =
6)
Next i

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


Merci pour les idées

JP
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #25949872
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
'------------------------------------------------
MichD
Le #25949922
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
JP
Le #25950502
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
MichD
Le #25950602
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
JP
Le #25950932
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
MichD
Le #25950962
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!
JP
Le #25950952
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
MichD
Le #25951112
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
JP
Le #25951212
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
MichD
Le #25951262
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
Publicité
Poster une réponse
Anonyme