J'ai cr=E9er une macro qui compare ligne =E0 ligne deux feuilles en
fonction de plusieurs crit=E8res et copies les valeur commune dans une
autre feuille.
Mon probl=E8me est que ma macro est lente (environ 25000 lignes =E0
l'heure) donc pour faire toutes les comparaisons il me faut environs
20h. Je m'explique la feuille 1 contient 50000 lignes et la feuille 2
25000 ce qui fait 325000000 de lignes =E0 traiter. Je ne veux pas
utiliser de logiciel de base de donn=E9e car ce nombre de ligne est
exeptionnel puisque je fait cette comparaison pour l'ann=E9e 2005
enti=E8re et qu'ensuite je la ferai tous les mois.
Donc je voulais savoir s'il =E9tait possible d'am=E9liorer un peu mon
code pour que cela aille un peu plus vite car cela d=E9passe mes
comp=E9tences.
Merci d'avant pour le temps que vous me consacrez et vous trouverez
ci-dessous mon code.
Cordialement Yoyo
Sub copie_valeurs()
'Copie dans la feuille 4 les donn=E9es des feuilles 2 et 3 dans la
feuille 4
>Dim Lextract, Lquotefile, Lsynthese As Variant
>Lsynthese =3D 1
>'Boucle de recherche
> For Lextract =3D 1 To 52000
> For Lquotefile =3D 1 To 5000
> ' On Error GoTo ERREUR
> 'Crit=E8res de recherche
> If (((Sheets(2).Range("E" & Lextract) =3D Sheets(3).Range(=
"O" & Lquotefile))) _
> Or ((Sheets(2).Range("E" & Lextract) =3D Sheets(3).Range("P=
" & Lquotefile)))) _
> And ((Sheets(2).Range("Y" & Lextract) =3D Sheets(3).Range(=
"M" & Lquotefile))) _
> And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("=
AE" & Lquotefile)) _
> And ((Sheets(2).Range("AI" & Lextract) > Sheets(3).Range("=
AE" & Lquotefile)))) Then
> 'Copie la ligne extract en An de la feuil4
> Sheets(2).Range("A" & Lextract, "BZ" & Lextract).Copy
> Sheets(4).Select
> Range("A" & Lsynthese).Select
> ActiveSheet.Paste
> ' Copie laligne du quote file en CAn de la feuil4
> Sheets(3).Range("A" & Lquotefile, "AZ" & Lquotefile).C=
opy
> Sheets(4).Select
> Range("CA" & Lsynthese).Select
> ActiveSheet.Paste
> 'incr=E9mentation de la ligne de la feuille synth=E8se
> Lsynthese =3D Lsynthese + 1
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
Radix??
Bonjour, Est ce que lorsque vous lancez cette macro il sepasse qque chose à l'affichage?
si oui placez: Application.ScreenUpdating = False au début de la boucle et remettez à true a la fin.
autre piste, voyez si il est possible d'accelerer le traitement en triant les données sources....
Radix
"Yoyo" a écrit dans le message de news: Bonjour à vous tous,
J'ai créer une macro qui compare ligne à ligne deux feuilles en fonction de plusieurs critères et copies les valeur commune dans une autre feuille.
Mon problème est que ma macro est lente (environ 25000 lignes à l'heure) donc pour faire toutes les comparaisons il me faut environs 20h. Je m'explique la feuille 1 contient 50000 lignes et la feuille 2 25000 ce qui fait 325000000 de lignes à traiter. Je ne veux pas utiliser de logiciel de base de donnée car ce nombre de ligne est exeptionnel puisque je fait cette comparaison pour l'année 2005 entière et qu'ensuite je la ferai tous les mois. Donc je voulais savoir s'il était possible d'améliorer un peu mon code pour que cela aille un peu plus vite car cela dépasse mes compétences. Merci d'avant pour le temps que vous me consacrez et vous trouverez ci-dessous mon code.
Cordialement Yoyo
Sub copie_valeurs()
'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4
Dim Lextract, Lquotefile, Lsynthese As Variant Lsynthese = 1 'Boucle de recherche For Lextract = 1 To 52000 For Lquotefile = 1 To 5000
' On Error GoTo ERREUR 'Critères de recherche
If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" & Lquotefile))) _
Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" & Lquotefile)))) _
And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" & Lquotefile))) _
And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" & Lquotefile)) _
And ((Sheets(2).Range("AI" & Lextract) > Sheets(3).Range("AE" & Lquotefile)))) Then
'Copie la ligne extract en An de la feuil4 Sheets(2).Range("A" & Lextract, "BZ" & Lextract).Copy Sheets(4).Select Range("A" & Lsynthese).Select ActiveSheet.Paste ' Copie laligne du quote file en CAn de la feuil4 Sheets(3).Range("A" & Lquotefile, "AZ" & Lquotefile).Copy
Sheets(4).Select Range("CA" & Lsynthese).Select ActiveSheet.Paste 'incrémentation de la ligne de la feuille synthèse Lsynthese = Lsynthese + 1
End If
Next Lquotefile Next Lextract
'Exit Sub 'ERREUR: 'Stop 'Resume End Sub
Bonjour,
Est ce que lorsque vous lancez cette macro il sepasse qque chose à
l'affichage?
si oui placez:
Application.ScreenUpdating = False
au début de la boucle et remettez à true a la fin.
autre piste, voyez si il est possible d'accelerer le traitement en triant
les données sources....
Radix
"Yoyo" <lemoine2.yohann@laposte.net> a écrit dans le message de
news:1137507609.159334.89320@g49g2000cwa.googlegroups.com...
Bonjour à vous tous,
J'ai créer une macro qui compare ligne à ligne deux feuilles en
fonction de plusieurs critères et copies les valeur commune dans une
autre feuille.
Mon problème est que ma macro est lente (environ 25000 lignes à
l'heure) donc pour faire toutes les comparaisons il me faut environs
20h. Je m'explique la feuille 1 contient 50000 lignes et la feuille 2
25000 ce qui fait 325000000 de lignes à traiter. Je ne veux pas
utiliser de logiciel de base de donnée car ce nombre de ligne est
exeptionnel puisque je fait cette comparaison pour l'année 2005
entière et qu'ensuite je la ferai tous les mois.
Donc je voulais savoir s'il était possible d'améliorer un peu mon
code pour que cela aille un peu plus vite car cela dépasse mes
compétences.
Merci d'avant pour le temps que vous me consacrez et vous trouverez
ci-dessous mon code.
Cordialement Yoyo
Sub copie_valeurs()
'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la
feuille 4
Dim Lextract, Lquotefile, Lsynthese As Variant
Lsynthese = 1
'Boucle de recherche
For Lextract = 1 To 52000
For Lquotefile = 1 To 5000
' On Error GoTo ERREUR
'Critères de recherche
If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O"
& Lquotefile))) _
Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" &
Lquotefile)))) _
And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M"
& Lquotefile))) _
And ((Sheets(2).Range("AJ" & Lextract) <
Sheets(3).Range("AE" & Lquotefile)) _
And ((Sheets(2).Range("AI" & Lextract) >
Sheets(3).Range("AE" & Lquotefile)))) Then
'Copie la ligne extract en An de la feuil4
Sheets(2).Range("A" & Lextract, "BZ" & Lextract).Copy
Sheets(4).Select
Range("A" & Lsynthese).Select
ActiveSheet.Paste
' Copie laligne du quote file en CAn de la feuil4
Sheets(3).Range("A" & Lquotefile, "AZ" &
Lquotefile).Copy
Sheets(4).Select
Range("CA" & Lsynthese).Select
ActiveSheet.Paste
'incrémentation de la ligne de la feuille synthèse
Lsynthese = Lsynthese + 1
Bonjour, Est ce que lorsque vous lancez cette macro il sepasse qque chose à l'affichage?
si oui placez: Application.ScreenUpdating = False au début de la boucle et remettez à true a la fin.
autre piste, voyez si il est possible d'accelerer le traitement en triant les données sources....
Radix
"Yoyo" a écrit dans le message de news: Bonjour à vous tous,
J'ai créer une macro qui compare ligne à ligne deux feuilles en fonction de plusieurs critères et copies les valeur commune dans une autre feuille.
Mon problème est que ma macro est lente (environ 25000 lignes à l'heure) donc pour faire toutes les comparaisons il me faut environs 20h. Je m'explique la feuille 1 contient 50000 lignes et la feuille 2 25000 ce qui fait 325000000 de lignes à traiter. Je ne veux pas utiliser de logiciel de base de donnée car ce nombre de ligne est exeptionnel puisque je fait cette comparaison pour l'année 2005 entière et qu'ensuite je la ferai tous les mois. Donc je voulais savoir s'il était possible d'améliorer un peu mon code pour que cela aille un peu plus vite car cela dépasse mes compétences. Merci d'avant pour le temps que vous me consacrez et vous trouverez ci-dessous mon code.
Cordialement Yoyo
Sub copie_valeurs()
'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4
Dim Lextract, Lquotefile, Lsynthese As Variant Lsynthese = 1 'Boucle de recherche For Lextract = 1 To 52000 For Lquotefile = 1 To 5000
' On Error GoTo ERREUR 'Critères de recherche
If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" & Lquotefile))) _
Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" & Lquotefile)))) _
And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" & Lquotefile))) _
And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" & Lquotefile)) _
And ((Sheets(2).Range("AI" & Lextract) > Sheets(3).Range("AE" & Lquotefile)))) Then
'Copie la ligne extract en An de la feuil4 Sheets(2).Range("A" & Lextract, "BZ" & Lextract).Copy Sheets(4).Select Range("A" & Lsynthese).Select ActiveSheet.Paste ' Copie laligne du quote file en CAn de la feuil4 Sheets(3).Range("A" & Lquotefile, "AZ" & Lquotefile).Copy
Sheets(4).Select Range("CA" & Lsynthese).Select ActiveSheet.Paste 'incrémentation de la ligne de la feuille synthèse Lsynthese = Lsynthese + 1
End If
Next Lquotefile Next Lextract
'Exit Sub 'ERREUR: 'Stop 'Resume End Sub
twintopiste
Essaie peut-etre avec ça :
Sub copie_valeurs() 'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4 Dim Lextract, Lquotefile, Lsynthese As Variant Lsynthese = 1 'Boucle de recherche For Lextract = 1 To 52000 For Lquotefile = 1 To 5000
' On Error GoTo ERREUR 'Critères de recherche If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" & Lquotefile))) _ Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" & Lquotefile)))) _ And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" & Lquotefile))) _ And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" & Lquotefile)) _ And ((Sheets(2).Range("AI" & Lextract) = Sheets(3).Range("AE" & Lquotefile)))) Then
For i = 1 To 78 ThisWorkbook.Sheets(4).Cells(i, Lsynthese) = ThisWorkbook.Sheets(2).Cells(i, Lextract) Next For i = 1 To 52 ThisWorkbook.Sheets(4).Cells(i + 79, Lsynthese) = ThisWorkbook.Sheets(3).Cells(i, Lquotefile) Next Lsynthese = Lsynthese + 1 End If
Next Lquotefile Next Lextract
'Exit Sub 'ERREUR: 'Stop 'Resume End Sub
Le but, c'est déviter le copier-coller. Ca prends bcp de temps pour pas grand chose ...
Bonjour à vous tous,
J'ai créer une macro qui compare ligne à ligne deux feuilles en fonction de plusieurs critères et copies les valeur commune dans une autre feuille.
Mon problème est que ma macro est lente (environ 25000 lignes à l'heure) donc pour faire toutes les comparaisons il me faut environs 20h. Je m'explique la feuille 1 contient 50000 lignes et la feuille 2 25000 ce qui fait 325000000 de lignes à traiter. Je ne veux pas utiliser de logiciel de base de donnée car ce nombre de ligne est exeptionnel puisque je fait cette comparaison pour l'année 2005 entière et qu'ensuite je la ferai tous les mois. Donc je voulais savoir s'il était possible d'améliorer un peu mon code pour que cela aille un peu plus vite car cela dépasse mes compétences. Merci d'avant pour le temps que vous me consacrez et vous trouverez ci-dessous mon code.
Cordialement Yoyo
Sub copie_valeurs()
'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4
Dim Lextract, Lquotefile, Lsynthese As Variant Lsynthese = 1 'Boucle de recherche For Lextract = 1 To 52000 For Lquotefile = 1 To 5000
' On Error GoTo ERREUR 'Critères de recherche
If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" & Lquotefile))) _ Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" & Lquotefile)))) _ And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" & Lquotefile))) _ And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" & Lquotefile)) _ And ((Sheets(2).Range("AI" & Lextract) > Sheets(3).Range("AE" & Lquotefile)))) Then 'Copie la ligne extract en An de la feuil4 Sheets(2).Range("A" & Lextract, "BZ" & Lextract).Copy Sheets(4).Select Range("A" & Lsynthese).Select ActiveSheet.Paste ' Copie laligne du quote file en CAn de la feuil4 Sheets(3).Range("A" & Lquotefile, "AZ" & Lquotefile).Copy Sheets(4).Select Range("CA" & Lsynthese).Select ActiveSheet.Paste 'incrémentation de la ligne de la feuille synthèse Lsynthese = Lsynthese + 1
End If
Next Lquotefile Next Lextract
'Exit Sub 'ERREUR: 'Stop 'Resume End Sub
Essaie peut-etre avec ça :
Sub copie_valeurs()
'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4
Dim Lextract, Lquotefile, Lsynthese As Variant
Lsynthese = 1
'Boucle de recherche
For Lextract = 1 To 52000
For Lquotefile = 1 To 5000
' On Error GoTo ERREUR
'Critères de recherche
If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" &
Lquotefile))) _
Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" &
Lquotefile)))) _
And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" &
Lquotefile))) _
And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" &
Lquotefile)) _
And ((Sheets(2).Range("AI" & Lextract) = Sheets(3).Range("AE" &
Lquotefile)))) Then
For i = 1 To 78
ThisWorkbook.Sheets(4).Cells(i, Lsynthese) =
ThisWorkbook.Sheets(2).Cells(i, Lextract)
Next
For i = 1 To 52
ThisWorkbook.Sheets(4).Cells(i + 79, Lsynthese) =
ThisWorkbook.Sheets(3).Cells(i, Lquotefile)
Next
Lsynthese = Lsynthese + 1
End If
Next Lquotefile
Next Lextract
'Exit Sub
'ERREUR:
'Stop
'Resume
End Sub
Le but, c'est déviter le copier-coller. Ca prends bcp de temps pour pas
grand chose ...
Bonjour à vous tous,
J'ai créer une macro qui compare ligne à ligne deux feuilles en
fonction de plusieurs critères et copies les valeur commune dans une
autre feuille.
Mon problème est que ma macro est lente (environ 25000 lignes à
l'heure) donc pour faire toutes les comparaisons il me faut environs
20h. Je m'explique la feuille 1 contient 50000 lignes et la feuille 2
25000 ce qui fait 325000000 de lignes à traiter. Je ne veux pas
utiliser de logiciel de base de donnée car ce nombre de ligne est
exeptionnel puisque je fait cette comparaison pour l'année 2005
entière et qu'ensuite je la ferai tous les mois.
Donc je voulais savoir s'il était possible d'améliorer un peu mon
code pour que cela aille un peu plus vite car cela dépasse mes
compétences.
Merci d'avant pour le temps que vous me consacrez et vous trouverez
ci-dessous mon code.
Cordialement Yoyo
Sub copie_valeurs()
'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la
feuille 4
Dim Lextract, Lquotefile, Lsynthese As Variant
Lsynthese = 1
'Boucle de recherche
For Lextract = 1 To 52000
For Lquotefile = 1 To 5000
' On Error GoTo ERREUR
'Critères de recherche
If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" & Lquotefile))) _
Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" & Lquotefile)))) _
And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" & Lquotefile))) _
And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" & Lquotefile)) _
And ((Sheets(2).Range("AI" & Lextract) > Sheets(3).Range("AE" & Lquotefile)))) Then
'Copie la ligne extract en An de la feuil4
Sheets(2).Range("A" & Lextract, "BZ" & Lextract).Copy
Sheets(4).Select
Range("A" & Lsynthese).Select
ActiveSheet.Paste
' Copie laligne du quote file en CAn de la feuil4
Sheets(3).Range("A" & Lquotefile, "AZ" & Lquotefile).Copy
Sheets(4).Select
Range("CA" & Lsynthese).Select
ActiveSheet.Paste
'incrémentation de la ligne de la feuille synthèse
Lsynthese = Lsynthese + 1
Sub copie_valeurs() 'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4 Dim Lextract, Lquotefile, Lsynthese As Variant Lsynthese = 1 'Boucle de recherche For Lextract = 1 To 52000 For Lquotefile = 1 To 5000
' On Error GoTo ERREUR 'Critères de recherche If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" & Lquotefile))) _ Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" & Lquotefile)))) _ And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" & Lquotefile))) _ And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" & Lquotefile)) _ And ((Sheets(2).Range("AI" & Lextract) = Sheets(3).Range("AE" & Lquotefile)))) Then
For i = 1 To 78 ThisWorkbook.Sheets(4).Cells(i, Lsynthese) = ThisWorkbook.Sheets(2).Cells(i, Lextract) Next For i = 1 To 52 ThisWorkbook.Sheets(4).Cells(i + 79, Lsynthese) = ThisWorkbook.Sheets(3).Cells(i, Lquotefile) Next Lsynthese = Lsynthese + 1 End If
Next Lquotefile Next Lextract
'Exit Sub 'ERREUR: 'Stop 'Resume End Sub
Le but, c'est déviter le copier-coller. Ca prends bcp de temps pour pas grand chose ...
Bonjour à vous tous,
J'ai créer une macro qui compare ligne à ligne deux feuilles en fonction de plusieurs critères et copies les valeur commune dans une autre feuille.
Mon problème est que ma macro est lente (environ 25000 lignes à l'heure) donc pour faire toutes les comparaisons il me faut environs 20h. Je m'explique la feuille 1 contient 50000 lignes et la feuille 2 25000 ce qui fait 325000000 de lignes à traiter. Je ne veux pas utiliser de logiciel de base de donnée car ce nombre de ligne est exeptionnel puisque je fait cette comparaison pour l'année 2005 entière et qu'ensuite je la ferai tous les mois. Donc je voulais savoir s'il était possible d'améliorer un peu mon code pour que cela aille un peu plus vite car cela dépasse mes compétences. Merci d'avant pour le temps que vous me consacrez et vous trouverez ci-dessous mon code.
Cordialement Yoyo
Sub copie_valeurs()
'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4
Dim Lextract, Lquotefile, Lsynthese As Variant Lsynthese = 1 'Boucle de recherche For Lextract = 1 To 52000 For Lquotefile = 1 To 5000
' On Error GoTo ERREUR 'Critères de recherche
If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" & Lquotefile))) _ Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" & Lquotefile)))) _ And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" & Lquotefile))) _ And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" & Lquotefile)) _ And ((Sheets(2).Range("AI" & Lextract) > Sheets(3).Range("AE" & Lquotefile)))) Then 'Copie la ligne extract en An de la feuil4 Sheets(2).Range("A" & Lextract, "BZ" & Lextract).Copy Sheets(4).Select Range("A" & Lsynthese).Select ActiveSheet.Paste ' Copie laligne du quote file en CAn de la feuil4 Sheets(3).Range("A" & Lquotefile, "AZ" & Lquotefile).Copy Sheets(4).Select Range("CA" & Lsynthese).Select ActiveSheet.Paste 'incrémentation de la ligne de la feuille synthèse Lsynthese = Lsynthese + 1
End If
Next Lquotefile Next Lextract
'Exit Sub 'ERREUR: 'Stop 'Resume End Sub
Youky
en complement de twintopiste: 'Pour diminuer la Boucle de recherche, 52000 est peut être plus qu'il n'en faut 5000 aussi For Lextract = 1 To Sheets(2).[E65536].End(xlUp).Row '52000 For Lquotefile = 1 To Sheets(3).[P65536].End(xlUp).Row '5000
"twintopiste" a écrit dans le message de news:
Essaie peut-etre avec ça :
Sub copie_valeurs() 'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4 Dim Lextract, Lquotefile, Lsynthese As Variant Lsynthese = 1 'Boucle de recherche For Lextract = 1 To 52000 For Lquotefile = 1 To 5000
' On Error GoTo ERREUR 'Critères de recherche If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" & Lquotefile))) _ Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" & Lquotefile)))) _ And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" & Lquotefile))) _ And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" & Lquotefile)) _ And ((Sheets(2).Range("AI" & Lextract) = Sheets(3).Range("AE" & Lquotefile)))) Then
For i = 1 To 78 ThisWorkbook.Sheets(4).Cells(i, Lsynthese) > ThisWorkbook.Sheets(2).Cells(i, Lextract) Next For i = 1 To 52 ThisWorkbook.Sheets(4).Cells(i + 79, Lsynthese) > ThisWorkbook.Sheets(3).Cells(i, Lquotefile) Next Lsynthese = Lsynthese + 1 End If
Next Lquotefile Next Lextract
'Exit Sub 'ERREUR: 'Stop 'Resume End Sub
Le but, c'est déviter le copier-coller. Ca prends bcp de temps pour pas grand chose ...
Bonjour à vous tous,
J'ai créer une macro qui compare ligne à ligne deux feuilles en fonction de plusieurs critères et copies les valeur commune dans une autre feuille.
Mon problème est que ma macro est lente (environ 25000 lignes à l'heure) donc pour faire toutes les comparaisons il me faut environs 20h. Je m'explique la feuille 1 contient 50000 lignes et la feuille 2 25000 ce qui fait 325000000 de lignes à traiter. Je ne veux pas utiliser de logiciel de base de donnée car ce nombre de ligne est exeptionnel puisque je fait cette comparaison pour l'année 2005 entière et qu'ensuite je la ferai tous les mois. Donc je voulais savoir s'il était possible d'améliorer un peu mon code pour que cela aille un peu plus vite car cela dépasse mes compétences. Merci d'avant pour le temps que vous me consacrez et vous trouverez ci-dessous mon code.
Cordialement Yoyo
Sub copie_valeurs()
'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4
Dim Lextract, Lquotefile, Lsynthese As Variant Lsynthese = 1 'Boucle de recherche For Lextract = 1 To 52000 For Lquotefile = 1 To 5000
' On Error GoTo ERREUR 'Critères de recherche
If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" & Lquotefile))) _ Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" & Lquotefile)))) _ And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" & Lquotefile))) _ And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" & Lquotefile)) _ And ((Sheets(2).Range("AI" & Lextract) > Sheets(3).Range("AE" & Lquotefile)))) Then 'Copie la ligne extract en An de la feuil4 Sheets(2).Range("A" & Lextract, "BZ" & Lextract).Copy Sheets(4).Select Range("A" & Lsynthese).Select ActiveSheet.Paste ' Copie laligne du quote file en CAn de la feuil4 Sheets(3).Range("A" & Lquotefile, "AZ" & Lquotefile).Copy Sheets(4).Select Range("CA" & Lsynthese).Select ActiveSheet.Paste 'incrémentation de la ligne de la feuille synthèse Lsynthese = Lsynthese + 1
End If
Next Lquotefile Next Lextract
'Exit Sub 'ERREUR: 'Stop 'Resume End Sub
en complement de twintopiste:
'Pour diminuer la Boucle de recherche, 52000 est peut être plus qu'il n'en
faut 5000 aussi
For Lextract = 1 To Sheets(2).[E65536].End(xlUp).Row '52000
For Lquotefile = 1 To Sheets(3).[P65536].End(xlUp).Row '5000
"twintopiste" <twintopiste@discussions.microsoft.com> a écrit dans le
message de news: 817B5FC5-E337-4363-9D97-BBA20EDC865E@microsoft.com...
Essaie peut-etre avec ça :
Sub copie_valeurs()
'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4
Dim Lextract, Lquotefile, Lsynthese As Variant
Lsynthese = 1
'Boucle de recherche
For Lextract = 1 To 52000
For Lquotefile = 1 To 5000
' On Error GoTo ERREUR
'Critères de recherche
If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" &
Lquotefile))) _
Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" &
Lquotefile)))) _
And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" &
Lquotefile))) _
And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" &
Lquotefile)) _
And ((Sheets(2).Range("AI" & Lextract) = Sheets(3).Range("AE" &
Lquotefile)))) Then
For i = 1 To 78
ThisWorkbook.Sheets(4).Cells(i, Lsynthese) > ThisWorkbook.Sheets(2).Cells(i, Lextract)
Next
For i = 1 To 52
ThisWorkbook.Sheets(4).Cells(i + 79, Lsynthese) > ThisWorkbook.Sheets(3).Cells(i, Lquotefile)
Next
Lsynthese = Lsynthese + 1
End If
Next Lquotefile
Next Lextract
'Exit Sub
'ERREUR:
'Stop
'Resume
End Sub
Le but, c'est déviter le copier-coller. Ca prends bcp de temps pour pas
grand chose ...
Bonjour à vous tous,
J'ai créer une macro qui compare ligne à ligne deux feuilles en
fonction de plusieurs critères et copies les valeur commune dans une
autre feuille.
Mon problème est que ma macro est lente (environ 25000 lignes à
l'heure) donc pour faire toutes les comparaisons il me faut environs
20h. Je m'explique la feuille 1 contient 50000 lignes et la feuille 2
25000 ce qui fait 325000000 de lignes à traiter. Je ne veux pas
utiliser de logiciel de base de donnée car ce nombre de ligne est
exeptionnel puisque je fait cette comparaison pour l'année 2005
entière et qu'ensuite je la ferai tous les mois.
Donc je voulais savoir s'il était possible d'améliorer un peu mon
code pour que cela aille un peu plus vite car cela dépasse mes
compétences.
Merci d'avant pour le temps que vous me consacrez et vous trouverez
ci-dessous mon code.
Cordialement Yoyo
Sub copie_valeurs()
'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la
feuille 4
Dim Lextract, Lquotefile, Lsynthese As Variant
Lsynthese = 1
'Boucle de recherche
For Lextract = 1 To 52000
For Lquotefile = 1 To 5000
' On Error GoTo ERREUR
'Critères de recherche
If (((Sheets(2).Range("E" & Lextract) =
Sheets(3).Range("O" & Lquotefile))) _
Or ((Sheets(2).Range("E" & Lextract) =
Sheets(3).Range("P" & Lquotefile)))) _
And ((Sheets(2).Range("Y" & Lextract) =
Sheets(3).Range("M" & Lquotefile))) _
And ((Sheets(2).Range("AJ" & Lextract) <
Sheets(3).Range("AE" & Lquotefile)) _
And ((Sheets(2).Range("AI" & Lextract) >
Sheets(3).Range("AE" & Lquotefile)))) Then
'Copie la ligne extract en An de la feuil4
Sheets(2).Range("A" & Lextract, "BZ" &
Lextract).Copy
Sheets(4).Select
Range("A" & Lsynthese).Select
ActiveSheet.Paste
' Copie laligne du quote file en CAn de la feuil4
Sheets(3).Range("A" & Lquotefile, "AZ" &
Lquotefile).Copy
Sheets(4).Select
Range("CA" & Lsynthese).Select
ActiveSheet.Paste
'incrémentation de la ligne de la feuille synthèse
Lsynthese = Lsynthese + 1
en complement de twintopiste: 'Pour diminuer la Boucle de recherche, 52000 est peut être plus qu'il n'en faut 5000 aussi For Lextract = 1 To Sheets(2).[E65536].End(xlUp).Row '52000 For Lquotefile = 1 To Sheets(3).[P65536].End(xlUp).Row '5000
"twintopiste" a écrit dans le message de news:
Essaie peut-etre avec ça :
Sub copie_valeurs() 'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4 Dim Lextract, Lquotefile, Lsynthese As Variant Lsynthese = 1 'Boucle de recherche For Lextract = 1 To 52000 For Lquotefile = 1 To 5000
' On Error GoTo ERREUR 'Critères de recherche If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" & Lquotefile))) _ Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" & Lquotefile)))) _ And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" & Lquotefile))) _ And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" & Lquotefile)) _ And ((Sheets(2).Range("AI" & Lextract) = Sheets(3).Range("AE" & Lquotefile)))) Then
For i = 1 To 78 ThisWorkbook.Sheets(4).Cells(i, Lsynthese) > ThisWorkbook.Sheets(2).Cells(i, Lextract) Next For i = 1 To 52 ThisWorkbook.Sheets(4).Cells(i + 79, Lsynthese) > ThisWorkbook.Sheets(3).Cells(i, Lquotefile) Next Lsynthese = Lsynthese + 1 End If
Next Lquotefile Next Lextract
'Exit Sub 'ERREUR: 'Stop 'Resume End Sub
Le but, c'est déviter le copier-coller. Ca prends bcp de temps pour pas grand chose ...
Bonjour à vous tous,
J'ai créer une macro qui compare ligne à ligne deux feuilles en fonction de plusieurs critères et copies les valeur commune dans une autre feuille.
Mon problème est que ma macro est lente (environ 25000 lignes à l'heure) donc pour faire toutes les comparaisons il me faut environs 20h. Je m'explique la feuille 1 contient 50000 lignes et la feuille 2 25000 ce qui fait 325000000 de lignes à traiter. Je ne veux pas utiliser de logiciel de base de donnée car ce nombre de ligne est exeptionnel puisque je fait cette comparaison pour l'année 2005 entière et qu'ensuite je la ferai tous les mois. Donc je voulais savoir s'il était possible d'améliorer un peu mon code pour que cela aille un peu plus vite car cela dépasse mes compétences. Merci d'avant pour le temps que vous me consacrez et vous trouverez ci-dessous mon code.
Cordialement Yoyo
Sub copie_valeurs()
'Copie dans la feuille 4 les données des feuilles 2 et 3 dans la feuille 4
Dim Lextract, Lquotefile, Lsynthese As Variant Lsynthese = 1 'Boucle de recherche For Lextract = 1 To 52000 For Lquotefile = 1 To 5000
' On Error GoTo ERREUR 'Critères de recherche
If (((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("O" & Lquotefile))) _ Or ((Sheets(2).Range("E" & Lextract) = Sheets(3).Range("P" & Lquotefile)))) _ And ((Sheets(2).Range("Y" & Lextract) = Sheets(3).Range("M" & Lquotefile))) _ And ((Sheets(2).Range("AJ" & Lextract) < Sheets(3).Range("AE" & Lquotefile)) _ And ((Sheets(2).Range("AI" & Lextract) > Sheets(3).Range("AE" & Lquotefile)))) Then 'Copie la ligne extract en An de la feuil4 Sheets(2).Range("A" & Lextract, "BZ" & Lextract).Copy Sheets(4).Select Range("A" & Lsynthese).Select ActiveSheet.Paste ' Copie laligne du quote file en CAn de la feuil4 Sheets(3).Range("A" & Lquotefile, "AZ" & Lquotefile).Copy Sheets(4).Select Range("CA" & Lsynthese).Select ActiveSheet.Paste 'incrémentation de la ligne de la feuille synthèse Lsynthese = Lsynthese + 1
End If
Next Lquotefile Next Lextract
'Exit Sub 'ERREUR: 'Stop 'Resume End Sub
Yoyo
Merci à vous trois twintopiste, Youky et Radix, pour vous etes penchés sur mon problèmes.
je vais appliquer vos sorlution et je vous tiens au courant
A bientot YOYO
Merci à vous trois twintopiste, Youky et Radix, pour vous etes
penchés sur mon problèmes.
je vais appliquer vos sorlution et je vous tiens au courant
