Booster macro

[jean]

bonjour au FORUM

Je cherche a accelerer mes macros car je dois attendre 30min pour que le resultat s'affiche: c'est beaucoup trop long
il y a peut etre qqc a faire sur l'ordinateur?

merci

 

[jean]

un petit coup de main s'il vous plait

 

[PascalXLD]

Oh là Jean depuis cet parès-midi je pense que tu n'as pas à te plaindre

Bon je ne comprends toujours pas cette histoire de erreur 400

Tu peux envoyer dans ma BAL si tu veux en retirant beaucoup de données pour pas trop lourd

pascalledean#hotmail.com

remplacer # par arobase

Mais tu sais je vais manger m'occuper de mes petits ok ??

 

[jean]

je te l'envoi

merci

 

[Hellboy]

DSA écrit:

Bonjour à tous,


'On recherche la dernière ligne de chaque feuille
i = 1
While FeuilTemp.Cells(i, Col1) <> ''
i = i + 1
Wend
derLigneTemp = i - 1
i = 1
While FeuilCompa.Cells(i, Col1) <> ''
i = i + 1
Wend
derLigneCompa = i - 1


DSA

DSA, petite remarque, cette partie du code augmente le temps de recherche pour la dernière ligne. Tu n'as pas besoin de boubler pour faire ça. Tu peux résumer avec la commande:

derLigneTemp = FeuilTemp.Cells(i, Col1).end(xldown).row

&

derLigneCompa = FeuilCompa.Cells(i, Col1).end(xldown).row

 

[PascalXLD]

Re

Jean tu peux préciser quelles colonnes tu veux comparer car dans ton code tu avais la colonne D et je vois quelle est vide

Donc si tu veux bien me mettre tes règles pour déterminer les colonnes à supprimer je regarderai cela mais je pense que demain car là je suis naze

Bonne soirée

 

[Hellboy]

bonsoir a tous

Pascal76, comment tu fais pour voir que la colonne D est vide ?

merci !

 

[jean]

re,
avant tout merci

en fait la colone d n'est pas vide elle l'est au debut mais environ 50 ou 100 lignes plus bas tu remarqueras des references>

elle doit donc etre pris en compte

 

[jean]

Salut helboy

avec ton code mon ordinateur affiche depassement de capacite
j'imagine que ma base de donnee est trop important, je compare 3000 lignes>
qu'en penses-tu?

Sub ordre2()
Application.ScreenUpdating = False
Dim u As Byte
Dim i As Integer
Sheets('ordre1').Select
Cells.Select
Selection.Copy
Sheets('1').Select
Cells(1, 1).Select
ActiveSheet.Paste


With Sheets('1')
For i = 1 To Sheets('ordre0').Range('A65000').End(xlUp).Row
For u = 1 To .Range('A65000').End(xlUp).Row
If Sheets('ordre0').Range('D' & i) = .Range('D' & u) And _
Sheets('ordre0').Range('D' & i) = .Range('D' & u) And _
Sheets('ordre0').Range('H' & i) = .Range('H' & u) And _
Sheets('ordre0').Range('J' & i) = .Range('J' & u) And _
Sheets('ordre0').Range('L' & i) = .Range('L' & u) And _
Sheets('ordre0').Range('A' & i) = .Range('A' & u) Then
.Range('D' & u).ActiveCell.EntireRow.Delete
End If
Next u
Next i

Application.ScreenUpdating = True
End With
End Sub

 

[PascalXLD]

Re

c'est reparti j'espère que cela ira cette fois ci

Il y avait un end if mal placé tu l'avais recopié trop loin
Il y avait une erreur de declaration de variable
et une erreur d'alimentation des tableaux sources

Voilà cela devrait allé là

 

[Sylvain]

Bonsoir,

Une idée qui me semble utile pour gagner du temps (si ça peut s'appliquer dans ce cas) :

&nbsp; &nbsp; Application.Calculation = xlManual
&nbsp; &nbsp; 'liste des instructions
&nbsp; &nbsp; Application.Calculation = xlAutomatic

 

[visiteur]

essai ça


Sheets('ordre1').Select
Cells.Select
Selection.Copy
Sheets('1').Select
Sheets('1').activate
Cells(1, 1).Select
ActiveSheet.Paste

 

[Hellboy]

Bonsoir jean

Salut helboy

avec ton code mon ordinateur affiche depassement de capacite
j'imagine que ma base de donnee est trop important, je compare 3000 lignes>
qu'en penses-tu?

Sub ordre2()
Application.ScreenUpdating = False
Dim u As Byte
Dim i As Integer

Excuse moi, j'ai fais une erreur d'assignation de variable, pas le bon type corrige ceci:

Dim u As Byte
Dim i As Integer

avec ceci:

Dim u As integer, i As Integer

p.s. a moins que tu ais plus de 32767 lignes de données, les variables ne seront plus bonne. Il faudra utiliser le type Long comme ceci:

Dim u As Long, i As Long

désolé ! 😱

a+

Message édité par: Hellboy, à: 30/06/2005 03:30

 

[DSA]

Bonour à tous,

juste un petit mot sur la remarque:

jean écrit:

Bonjour dsa


je viens d'essayer ta macro mais il y a un probleme en ce qui concerne:

FeuilCompa.Range(FeuilCompa.Cells(1, Col1), FeuilCompa.Cells(derLigneCompa, Col2)).SortKey1:=FeuilCompa.Cells(1, Col1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False,Orientation:=xlTopToBottom
FeuilTemp.Range(FeuilTemp.Cells(1, Col1), FeuilTemp.Cells(derLigneTemp, Col2)).SortKey1:=FeuilTemp.Cells(1, Col1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False,Orientation:=xlTopToBottom


2erreur de sintaxe

Jean, dans ta recopie, tu as oublié un espace entre le .Sort et le key1 (.Sort key1:=)

Heellboy, je connais le code avec le xldown mais je préfère le while (les deux boucles while mettent moins de 3s pour screener + de 3000 lignes)...

Perso, je pense que le if avec des AND en série est très consommateur de temps.....

Petite question à Jean: dans tes data, est-ce que tu as une colonne qui est toujours remplie?

A+

DSA

 

[PascalXLD]

Bonjour

Bon en prenant ma douche ce matin je me suis dit que j'avais pris le truc à l'envers (comme quoi Jean ton truc nous occupe la tête 😛 )

Donc voici la version je pense la plus rapide avec les variables tableau mais en en retirant pas des données mais en ajoutant celles qui ne sont pas doublées

Bonne journée à tous

Sub ordre1()

Dim MonTableauSource As Variant
Dim MonTableauSource2
Dim MonTableauCible()
Dim MaLigne As Long
Dim x As Long, y As Long, z As Long, i As Byte
Dim verif As Boolean

MaLigne = Worksheets('Ordre1').Range('A65536').End(xlUp).Row

MonTableauSource = Sheets('Ordre1').Range('A1😛' & MaLigne)

MaLigne = Worksheets('Ordre0').Range('A65536').End(xlUp).Row

z = 0
MonTableauSource2 = Worksheets('ordre0').Range('A1😛' & MaLigne)

For x = 1 To UBound(MonTableauSource)
verif = False
For y = 1 To UBound(MonTableauSource2)
If MonTableauSource(x, 1) = MonTableauSource2(y, 1) And MonTableauSource(x, 4) = MonTableauSource2(y, 4) And MonTableauSource(x, 8) = MonTableauSource2(y, 8) And MonTableauSource(x, 10) = MonTableauSource2(y, 10) And MonTableauSource(x, 12) = MonTableauSource2(y, 12) Then
verif = True
Exit For
End If
Next y
If verif = False Then
z = z + 1
ReDim Preserve MonTableauCible(1 To 16, 1 To z)
For i = 1 To 16
MonTableauCible(i, z) = MonTableauSource(x, i)
Next
End If
Next x


Worksheets('1').Range('A1😛' & z) = Application.Transpose(MonTableauCible)


End Sub

EDITION : remplacer 😛 par : P sans l'espace

Message édité par: Pascal76, à: 30/06/2005 10:39

 

[DSA]

ReBonjour à tous,

parmis les plusieurs personnes qui ont le fichier de data sur leur disque, est-ce que quelqu'un pourrait essayer de le mettre enchargement en éliminant le max de data (je pense qu'un fichier de 300 lignes sur 2 ou 3 onglet doit pouvoir passer)? Cela rendrait plus simple les tests de macro, ainsi que la compréhension des macros d'origine.

A+

DSA