VBA boucle while trop lente

Question

Je débute en VBA et j'ai un problème avec une macro qui utilise une double boucle while mais qui met trop de temps à s'exécuter. Voici ce que je demande de à ma fonction, j'ai une feuille avec plusieurs données (numéro de commande, référence, date de la commande, etc...) où sont remplis des commentaires. Chaque semaine cette feuille est mis à jours avec les nouvelles commandes qui se sont ajoutées (les données proviennent d'une extraction du logiciel de commande) et je dois copier les commentaires de la semaine précédente dans la feuille de la semaine actuelle. Je repère une commande avec identique d'une semaine à l'autre avec sa référence, sa quantité commandée, sa date de réception et son commentaire. J'ai donc fait une première boucle while qui parcours la feuille de la semaine précédente puis une seconde qui parcours la feuille de la semaine actuelle pour copier les commentaires mais cette macro met trop de temps à s'éxécuter (environ 4 à 5 min). Voici mon code : 'Récupération du nom du classeur de la semaine précédente pour pouvoir l'utiliser dans la suite de la fonction Dim WB As Workbook If Workbooks.Count = 2 Then For i = 1 To 2 If Not Workbooks(i).Name = ThisWorkbook.Name Then Set WB = Workbooks(i) Next i End If 'Definition des variables Dim feuillePrecedente As String, feuilleActuel As String 'Les noms des feuilles de la semaine actuelle (feuille "mise en forme") et de la semaine précédente sont récupérés feuillePrecedente = WB.Sheets(1).Name feuilleActuel = ThisWorkbook.Sheets("mise en forme").Name 'Sélection de la 1ère cellule de la colonne Référence de la feuille de la semaine actuelle Dim CellReferenceF1 As Range Set CellReferenceF1 = ThisWorkbook.Worksheets(feuilleActuel).Range("C2") 'Sélection de la 1ère cellule de la colonne quantité commandée de la feuille de la semaine actuelle Dim CellQuantiteF1 As Range Set CellQuantiteF1 = ThisWorkbook.Worksheets(feuilleActuel).Range("D2") 'Sélection de la 1ère cellule de la colonne date de réception planifiée de la feuille de la semaine actuelle Dim CellDateRecepF1 As Range Set CellDateRecepF1 = ThisWorkbook.Worksheets(feuilleActuel).Range("H2") 'Sélection de la 1ère cellule de la colonne commentaires de la feuille de la semaine actuelle Dim CellCommentaireF1 As Range Set CellCommentaireF1 = ThisWorkbook.Worksheets(feuilleActuel).Range("L2") 'Sélection de la 1ère cellule de la colonne Référence de la feuille de la semaine précédente Dim CellReferenceF2 As Range Set CellReferenceF2 = WB.Worksheets(feuillePrecedente).Range("C8") 'Sélection de la 1ère cellule de la colonne quantité commandée de la feuille de la semaine précédente Dim CellQuantiteF2 As Range Set CellQuantiteF2 = WB.Worksheets(feuillePrecedente).Range("D8") 'Sélection de la 1ère cellule de la colonne date de réception planifiée de la feuille de la semaine précédente Dim CellDateRecepF2 As Range Set CellDateRecepF2 = WB.Worksheets(feuillePrecedente).Range("H8") 'Sélection de la 1ère cellule de la colonne commentaires de la feuille de la semaine précédente Dim CellCommentaireF2 As Range Set CellCommentaireF2 = WB.Worksheets(feuillePrecedente).Range("L8") 'Définition d'une variable qui va parcourir la feuille de la semaine précédente Dim CompteurF2 As Double CompteurF2 = 0 'Définition d'une variable qui va parcourir la feuille de la semaine actuelle Dim CompteurF1 As Double 'Définition de la variable booléenne "recopie" Dim Recopie As Boolean 'Le premier while parcours la feuille de la semaine précédente et le second while parcours la feuille de la semaine actuelle While CellReferenceF2.Offset(CompteurF2, 0).Value &lt;&gt; "" CompteurF1 = 0 Recopie = False While (CellReferenceF1.Offset(CompteurF1, 0).Value &lt;&gt; "") And (Recopie = False) ' Si la référence, la date de réception planifiée et la quantité commandée sont égales dans les 2 feuilles alors le commentaire de la semaine précédente et copié dans la feuille de la semaine actuelle If (CellReferenceF1.Offset(CompteurF1, 0).Value = CellReferenceF2.Offset(CompteurF2, 0).Value) And (CellQuantiteF1.Offset(CompteurF1, 0).Value = CellQuantiteF2.Offset(CompteurF2, 0).Value) And (CellDateRecepF1.Offset(CompteurF1, 0).Value = CellDateRecepF2.Offset(CompteurF2, 0).Value) Then CellCommentaireF1.Offset(CompteurF1, 0).Value = CellCommentaireF2.Offset(CompteurF2, 0).Value Recopie = True End If CompteurF1 = CompteurF1 + 1 Wend CompteurF2 = CompteurF2 + 1 Wend Comme je débute en vba je pense qu'il est possible d'optimiser cette macro pour qu'elle soit beaucoup plus rapide mais je ne vois pas comment faire. Quelqu'un pourrait-il m'aider svp ? Je vous remercie d'avance...

eriiic · Answer

Si tu pouvais créer un fichier de quelques lignes qui représentent tous les cas de figure Avec les 2 feuilles, et en précisant les colonnes clé et commentaire. Précise aussi le nombre maxi de lignes. Selon la taille de la base plusieurs possibilités plus ou moins rapides (et donc plus ou moins simples) eric...

eriiic · Answer

Ils sont plus gros que 300ko. Ne mettre que qcq lignes représentant tous les cas, c'est suffisant. Et quel est le format exact des noms de fichier ? En vba il faut être précis... eric...

eriiic · Answer

Les zipper ou bien les déposer sur cjoint.com et coller ici le lien fourni. Si tu rassembles les 2 feuilles dans le même fichier ça simplifie la macro. eric...

eriiic · Answer

Attention à WB.Sheets(1). Je l'ai laissé mais tu t'adresses à la feuille en position 1.

Utilise plutôt le nom de la feuille ou son codename qui ne dépendent pas de sa position.

Je me sers temporairement de la colonne M de 'QRY HA1_260514_formaté ', modifier si elle est susceptible de servir.

Au passage les espaces derrière les noms des feuilles sont à proscrire, trop piègieux...

Je n'ai pas trop testé vue l'heure.

Sub MiseAJour()
    'Definition des variables
    Dim shPrecedente As Worksheet, shActuel As Worksheet
    Dim WB As Workbook, i As Long
    Dim lig1 As Long, derlig1 As Long, lig2 As Long, derlig2 As Long
    Dim data1 As Variant, data2 As Variant, clé() As String
    Dim clé1 As String, c As Range
    Dim comment2() As String
    'Récupération du nom du classeur de la semaine précédente pour pouvoir l'utiliser dans la suite de la fonction
    If Workbooks.Count = 2 Then
        For i = 1 To 2
            If Not Workbooks(i).Name = ThisWorkbook.Name Then Set WB = Workbooks(i)
        Next i
    Else
        MsgBox "Pas 2 classeurs uniquement, abandon"
        Exit Sub
    End If

    'Les feuilles de la semaine actuelle (feuille "mise en forme") et de la semaine précédente sont récupérés
    Set shPrecedente = WB.Sheets(1)
    Set shActuel = ThisWorkbook.Sheets("mise en forme")

    'mise en mémoire des données
    derlig1 = shPrecedente.Cells(Rows.Count, 1).End(xlUp).Row
    data1 = shPrecedente.[A8].Resize(derlig1 - 8, 12)
    ReDim clé(1 To UBound(data1))
    derlig2 = shActuel.Cells(Rows.Count, 1).End(xlUp).Row
    data2 = shActuel.[A2].Resize(derlig1 - 1, 12)
    ReDim comment2(1 To UBound(data2))
    ' fabrication clés
    For lig1 = 1 To UBound(data1)
        clé(lig1) = data1(lig1, 3) & data1(lig1, 4) & data1(lig1, 8)
    Next lig1
    shPrecedente.[M8].Resize(UBound(data1)) = Application.Transpose(clé)
    ' recup commentaires
    For lig2 = 1 To UBound(data2)
        clé1 = data2(lig2, 3) & data2(lig2, 4) & data2(lig2, 8)
        Set c = shPrecedente.[M:M].Find(clé1, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            ' clé trouvée
            If Not IsEmpty(data1(c.Row - 7, 12)) Then
                comment2(lig2) = data1(c.Row - 7, 12)
                If data1(c.Row - 7, 12) = "annulée" Then shActuel.Rows(lig2+1).Font.Bold = True
            End If
        End If
    Next lig2

    shPrecedente.[M:M].ClearContents
    shActuel.[L2].Resize(UBound(comment2)) = Application.Transpose(comment2)
End Sub

eric

PS: je met en gras les lignes avec "annulée"

eriiic · Answer

Mettre les données dans des variables tableau est beaucoup plus rapide. Déjà parce qu'on lit/écrit les données en un bloc, plutôt que d'effectuer de multiples lectures/écritures sur la feuille extrêmement chronophages. On travaille en mémoire. J'ai commenté un peu plus le code. A noter que j'ai changé la recherche de la clé. J'avais fait le fainéant hier soir car il était un peu tard quand je m'y suis mis. Je collais les clés en M pour les rechercher facilement avec un .find() sur la feuille. Maintenant je fais une boucle en mémoire, 10 fois plus rapide pour cette partie. J'ai mis les 2 feuilles dans le même classeur pour te montrer un problème. Regarde les lignes 108-109 et leur équivalent 114-115 sur l'autre feuille, elles ont la même clé (les 3 champs) et ne peuvent être distinguées. Je récupère donc un commentaire à tort. Faut-il ajouter un champ à la clé où est-ce une erreur dans le fichier de test, ce cas n'existant pas en réalité ? (les clés mises en N ne sont là que pour faciliter le débogage et ne sont pas nécessaires) Récupère et teste le nouveau code dans le fichier. eric...