Optimisation de code

Bonjour tout le monde !

J'ai fait un code qui fonctionne mais qui a besoin d'être optiisé, seulement mon code optimisé ne fonctionne pas...

Il a l'air de travailler mais ne retourne aucun résultat.

Auriez vous une idée svp ?

code optimisé

Sub test()
Application.ScreenUpdating = False
A = Worksheets("Import SN data").Range("A" & Rows.Count).End(xlUp).Row
B = Worksheets("Import Batch data").Range("A" & Rows.Count).End(xlUp).Row
C = 0
D = 1
Dim ref
With Worksheets("production data")
fin = Worksheets("production data").Range("A" & Rows.Count).End(xlUp).Row
Do While C <> D
For k = 2 To fin
    If IsEmpty(Worksheets("production data").Cells(k, 6)) = False Then
        On Error Resume Next
        ref = .Range("A2:A" & fin).Find(Left(.Range("A" & k), 6), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Address
        If Right(ref.Offset(, 4).Value, 5) = Cells(k, 4) Then
            If Right(Left(ref.Offset(, 4).Value, 12), 3) = Worksheets("production data").Cells(k, 3) Then
                If CInt(Right(Left(ref.Offset(, 4).Value, 8), 2)) = Worksheets("production data").Cells(k, 2) Then
                    ref.Offset(, 7).Value = Worksheets("production data").Cells(k, 1)
                    ref.Offset(, 7).Interior.Color = vbGreen
                    ref.Offset(, 8).Value = Worksheets("production data").Cells(k, 4)
                    ref.Offset(, 9).Value = Worksheets("production data").Cells(k, 2)
                    ref.Offset(, 10).Value = Worksheets("production data").Cells(k, 3)
                    ref.Offset(, 5).Value = Worksheets("production data").Cells(k, 6)
                End If
            End If
        End If
    End If
Next k
D = C
C = Application.WorksheetFunction.CountIf(Worksheets("production data").Range("F2:F" & fin), Worksheets("Main Menu").Range("J9"))
Worksheets("production data").Cells(fin + 5, 3) = C
Worksheets("production data").Cells(fin + 6, 3) = D
Loop
End With

End Sub

code qui fonctionnait avant :

Private Sub CommandButton6_Click()
Application.ScreenUpdating = False
A = Worksheets("Import SN data").Range("A" & Rows.Count).End(xlUp).Row
B = Worksheets("Import Batch data").Range("A" & Rows.Count).End(xlUp).Row
C = 0
D = 1
With Worksheets("production data")
fin = Worksheets("production data").Range("A" & Rows.Count).End(xlUp).Row
Do While C <> D
For k = 2 To fin
    If IsEmpty(Worksheets("production data").Cells(k, 6)) = False Then
        For i = 2 To fin
            If Left(Worksheets("production data").Cells(i, 5), 6) = Worksheets("production data").Cells(k, 1) Then
                If Right(Cells(i, 5), 5) = Cells(k, 4) Then
                    If Right(Left(Worksheets("production data").Cells(i, 5), 12), 3) = Worksheets("production data").Cells(k, 3) Then
                            If CInt(Right(Left(Worksheets("production data").Cells(i, 5), 8), 2)) = Worksheets("production data").Cells(k, 2) Then
                                Worksheets("production data").Cells(i, 8) = Worksheets("production data").Cells(k, 1)
                                Worksheets("production data").Cells(i, 8).Interior.color = vbGreen
                                Worksheets("production data").Cells(i, 9) = Worksheets("production data").Cells(k, 4)
                                Worksheets("production data").Cells(i, 10) = Worksheets("production data").Cells(k, 2)
                                Worksheets("production data").Cells(i, 11) = Worksheets("production data").Cells(k, 3)
                                Worksheets("production data").Cells(i, 6) = Worksheets("production data").Cells(k, 6)
                            End If
                    End If
                End If
            End If
        Next i
    End If
Next k
D = C
C = Application.WorksheetFunction.CountIf(Worksheets("production data").Range("F2:F" & fin), Worksheets("Main Menu").Range("J9"))
Worksheets("production data").Cells(fin + 5, 3) = C
Worksheets("production data").Cells(fin + 6, 3) = D
Loop
End With
End Sub

et voici mon fichier :

Les boutons ne sont pas utiles, je travail dans le module 1...

Ce document est un crash text qui me permet de mettre mes codes au point avant de les utiliser dans mon gros fichier !

Merci d'avance pour l'aide !!

Bonsoir,

Le fichier ne passe pas : sans doute trop volumineux.

Zip le s'il n'est pas trop gros ou passe par cjoint et donne nous le lien de téléchargement.

A+

Pour comprendre le but du code vous pouvez quand même utiliser le bouton "compile data" dans le menu

L'objectif étant de relier des séries de pièces en se basant sur les "current location", si je mets un nombre dans le Idaircraft, alors toutes les pièces liées doivent prendre le même Idaircraft.

Merci pour votre aide !


Et voici un lien de téléchargement pour le fichier

Merci !

Bonsoir loicd181, galopin01

ton fichier n'est pas accessible car ce n'est qu'un ligne écrite

Bonsoir,

Mettre des Offset partout n'est pas de l'optimisation : Bien au contraire. Il est bien préférable de coder avec les adresses de Cells "en dur" plutôt qu'en Offset qui oblige VBA à faire tout un tas de conversion (multiplié par le nombre de boucle c'est une perte de temps non négligeable.

Le code optimisé serait celui-ci j'ai ôté la référence à A et B qui ne sont pas utilisés.

Pour aller plus loin dans l'optimisation il faut absolument la feuille production_data.

En l'absence de fichier joint je ne peux pas aller plus loin.

Private Sub CommandButton6_Click()
Dim i&, k&, c&, d&, fin&
Dim WsW As Worksheet
Set WsW = Worksheets("production data")
Application.ScreenUpdating = False
c = 0
d = 1
With WsW
fin = WsW.Range("A" & Rows.Count).End(xlUp).Row
Do While c <> d
For k = 2 To fin
    If IsEmpty(WsW.Cells(k, 6)) = False Then
        For i = 2 To fin
            If Left(WsW.Cells(i, 5), 6) = WsW.Cells(k, 1) Then
                If Right(Cells(i, 5), 5) = Cells(k, 4) Then
                    If Right(Left(WsW.Cells(i, 5), 12), 3) = WsW.Cells(k, 3) Then
                            If CInt(Right(Left(WsW.Cells(i, 5), 8), 2)) = WsW.Cells(k, 2) Then
                                WsW.Cells(i, 8) = WsW.Cells(k, 1)
                                WsW.Cells(i, 8).Interior.Color = vbGreen
                                WsW.Cells(i, 9) = WsW.Cells(k, 4)
                                WsW.Cells(i, 10) = WsW.Cells(k, 2)
                                WsW.Cells(i, 11) = WsW.Cells(k, 3)
                                WsW.Cells(i, 6) = WsW.Cells(k, 6)
                            End If
                    End If
                End If
            End If
        Next i
    End If
Next k
d = c
c = Application.WorksheetFunction.CountIf(WsW.Range("F2:F" & fin), Worksheets("Main Menu").Range("J9"))
WsW.Cells(fin + 5, 3) = c
WsW.Cells(fin + 6, 3) = d
Loop
End With
End Sub

A+

Bonsoir,

Le nouveau lien ne fonctionne pas non plus ?


Merci pour la proposition !

Je teste de suite !!

Re...

J'ai trouvé le lien.

J'ai corrigé un petit bug dans ma macro: Le bug était :

Set WsW = WsW

qu'il faut remplacer par :

Set WsW = Worksheets("production data")

... mais je bute sur la ligne :

c = Application.WorksheetFunction.CountIf(WsW.Range("F2:F" & fin), Worksheets("Main Menu").Range("J9"))

Un peu au hasard j'ai remplacé "Main Menu" par "Menu" ce qui provoque la fin de la macro...

Je vais maintenant essayer d'analyser ce que tu as voulu faire...

A+

[Edit]

Tout à fait au hasard :

Quel était le but du

A = Worksheets("Import SN data").Range("A" & Rows.Count).End(xlUp).Row
B = Worksheets("Import Batch data").Range("A" & Rows.Count).End(xlUp).Row

que j'ai supprimé car je ne voyais pas l'incidence dans la macro. Y a-il un rapport entre ces 3 feuilles et ton bricolage ?

Pour l'instant je suis tenté de croire que tu as semé du "production data" un peu partout alors que tu voulais faire des comparaisons feuille à feuille, C'est ça ?

Merci !!

J'essayais de comprendre l'erreur mais je n'arrivais pas à trouver !!

Le code 3 bonnes minutes et je pense que c'est pas très difficile, c'est suremement moi qui ai mal incrémenté...

Pour réinitialiser, tu peux cliquer sur le bouton "compile data". Ca remet tout à l'état initial. L'objectif de cette macro est de suivre un abre de production, dans une autre macro, je compare le tableau à un abre et l'erbre verdit au fur et a mesure que les IDaircraft se propagent...

Merci de l'aide !


Non non ces lignes sont une erreurs de suppression...

Elles étaient la pour des tests avant!


Alors il y a du production data partout car le code doit fonctionner avec un bouton et le simple fait d'utiliser le with faisait que la macro n'agissait pas...

La production data est la somme de Import SN data et Import Batch data

Pour l'instant je suis tenté de croire que tu as semé du "production data" un peu partout alors que tu voulais faire des comparaisons feuille à feuille, C'est ça ?

Le bouton "compile" créé la feuille production data.

Ensuite, je ne travail qu'avec production data et c'est tout à fait normal. En fait j'obtiens des données de access (import sn data et import batch data) je les compile et ensuite je les utilises....

Est ce que c'est plus clair ?

bonbon !

C'est à dire ? ^^

Merci pour l'aide parce que la je commence à sécher j'ai plus d'idée..

En fait c'est pas le with qui pose problème (je n'avais même pas remarqué...)

Avec le With en fait on peut suprimer tous les WsW ensuite (à condition de laisser le point..)

Bon c'est pas tout ça, de toute façon c'est pas ça le problème. Il va falloir que je creuse ton histoire d'arbre et de propagation...

A+

Rechercher des sujets similaires à "optimisation code"