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
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 '------------------------------------------------
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)
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
'------------------------------------------------
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
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)
'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
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)
'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
'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
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
'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 '------------------
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
'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
'------------------
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
'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 '------------------
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
Sub copyEntreprise()
'déclaration des variables
Dim T()
Dim Tab_adresse()
Dim i As Long
Dim DerniereAdresse As Long 'integer
Dim Start As Double
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
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
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
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?
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 '-------------------------
'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
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
'-------------------------
'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
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 '-------------------------
'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
MsgBox "durée du traitement: " & (Timer - Start) / 1000 & " secondes" End Sub
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
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.
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
Option Explicit Sub copyEntreprise()
'déclaration des variables Dim T() Dim Tab_adresse() Dim i As Long Dim DerniereAdresse As Long 'integer
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 '-------------------------
'------------------------- '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
Option Explicit
Sub copyEntreprise()
'déclaration des variables
Dim T()
Dim Tab_adresse()
Dim i As Long
Dim DerniereAdresse As Long 'integer
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
'-------------------------
'-------------------------
'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
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 '-------------------------
'------------------------- '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