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

 

[PascalXLD]

re

Voici le fichier épuré

Par contre je pense qu'il n'y aura pas photo entre travailler sur des variables et travailler sur des cellules

[file name=Classeur2_20050630104713.zip size=48564]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Classeur2_20050630104713.zip[/file]

 

[jean]

bonjour pascal

un gd merci pour le coup de main

je viens d'essayer ta macro: encore un petit probleme!

Quand nombre de lignes>500 dans ordre 1 je recois le message/

'erraur 13, incompatibilite de type'

tant que je ne depasse pas les 500 lignes la macro s'execute normalement

 

[2passage]

Bonjour,

Juste une idée comme ça, plus ou moins évoquée avant : les if / and enchainé ca bouffe du temps pour rien. en imbriquant différents IF, on sort des tests dès qu'une condition n'est pas remplie. En mettant les conditions dans un ordre logique (la condition la plus restrictive en premier) on doit gagner pas mal de ressources machine...

A+

 

[PascalXLD]

Avec l'idée de 2passage cela donnerait
Option Explicit


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) Then
If MonTableauSource(x, 4) = MonTableauSource2(y, 4) Then
If MonTableauSource(x, 8) = MonTableauSource2(y, 8) Then
If MonTableauSource(x, 10) = MonTableauSource2(y, 10) Then
If MonTableauSource(x, 12) = MonTableauSource2(y, 12) Then
verif = True
Exit For
End If
End If
End If
End If
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

PAr contre Jean bizarre ce que tu dis supérieur à 500 car avec le fichier que tu m'as envoyé avec les 3000 lignes ma macro ne bug pas

 

[PascalXLD]

Re

Je viens de faire un test avec la dernière version et les + de 3000 lignes cela prend 10 secondes avec un Pentium4 2800 512Mo de Ram contre 25 secondes sans les if imbriqués

Voilà

Message édité par: Pascal76, à: 30/06/2005 12:26

 

[jean]

re,

apres le message erreur 13....

il me surligne ca/
Worksheets('1').Range('A1' & z) = Application.Transpose(MonTableauCible)

moi ca continue a buger


je verifis encore et encore

a+

 

[jean]

re,

tu peux m'envoyer par mail ce que tu as trouvé?

je galére vraiment trop

merci

 

[PascalXLD]

Bon je ne sais pas ce qui se passe impossible de joindre mon fichier pour te l'envoyer par mail

Peux-tu toi me le renvoyer que je regarde ton truc

Sinon tu es sur quel excel ???

 

[jean]

re,

je suis sur excel 2000

 

[PascalXLD]

re

Alors là franchement j'y comprend rien avec ton fichier ça bug avec la macro copier du mien qui ne bug pas
Tu dois avoir une propriété du fichier qui gène c'est pas possible mais je vois pas

Modifies la macro comme ceci ça a marché sur ton fichier (un peu plus long mais bon tu auras le résultat)

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) Then
If MonTableauSource(x, 4) = MonTableauSource2(y, 4) Then
If MonTableauSource(x, 8) = MonTableauSource2(y, 8) Then
If MonTableauSource(x, 10) = MonTableauSource2(y, 10) Then
If MonTableauSource(x, 12) = MonTableauSource2(y, 12) Then
verif = True
Exit For
End If
End If
End If
End If
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

For x = 1 To 16
For y = 1 To z
Worksheets('1').Cells(y, x) = MonTableauCible(x, y)
Next
Next

End Sub

 

[jean]

Super pascal


ca marche!


merci

 

[DSA]

Bonjour,

Chapeau à Mr Pascal76, tu as raison ta macro est nettement plus rapide que la mienne.

Encore bravo

A+

DSA