Accélération de traitement

Le 09/09/2013 à 13:39

Bonjour,

je viens de créer un code, par contre malgré l'utilisation de variables tableau, celui ci est tres lent.

La feuille "Données" contient 900 lignes

La feuille "Mag" contient 3900 lignes

Merci de votre aide

Sub Magasin_Attendus()
    Dim NbLigneRQ, NbLigneMag, ComptLigneRQ, ComptLigneMag As Long
    Dim RefDonnees, RefMag As String
    Dim TabloRQ As Variant
    '**************************************************************************************************
    With Sheets("Données")
        NbLigneRQ = .Range("A" & .Rows.Count).End(xlUp).Row
        NbLigneMag = Sheets("Mag").Range("A" & .Rows.Count).End(xlUp).Row
        .Range("H2:R" & Rows.Count).ClearContents
        ReDim TabloRQ(1 To NbLigneRQ - 1, 1 To 11)
        For ComptLigneRQ = 2 To NbLigneRQ
            RefDonnees = .Range("A" & ComptLigneRQ).Value
            For ComptLigneMag = 2 To NbLigneMag
                RefMag = Sheets("Mag").Range("A" & ComptLigneMag).Value
                If RefMag = RefDonnees Then
                    '***Magasin Attendu********************************************************************************
                    TabloRQ(ComptLigneRQ - 1, 1) = Sheets("Mag").Range("C" & ComptLigneMag).Value
                    '***Emplacement Attendu**************************************************************************
                    TabloRQ(ComptLigneRQ - 1, 2) = Sheets("Mag").Range("D" & ComptLigneMag).Value
                    '***Magasin Du**************************************************************************************
                    TabloRQ(ComptLigneRQ - 1, 3) = Sheets("Mag").Range("E" & ComptLigneMag).Value
                    '***Emplacement Du********************************************************************************
                    TabloRQ(ComptLigneRQ - 1, 4) = Sheets("Mag").Range("F" & ComptLigneMag).Value
                    '***Prix de Vente************************************************************************************
                    TabloRQ(ComptLigneRQ - 1, 5) = Sheets("Mag").Range("H" & ComptLigneMag).Value
                    '***Chiffre d'Affaire***********************************************************************************
                    TabloRQ(ComptLigneRQ - 1, 6) = .Range("F" & ComptLigneRQ).Value * TabloRQ(ComptLigneRQ - 1, 5)
                    '***Taux MP******************************************************************************************
                    TabloRQ(ComptLigneRQ - 1, 7) = Sheets("Mag").Range("S" & ComptLigneMag).Value
                    '***Cout MP******************************************************************************************
                    TabloRQ(ComptLigneRQ - 1, 8) = TabloRQ(ComptLigneRQ - 1, 6) * TabloRQ(ComptLigneRQ - 1, 7)
                    '***Mois***********************************************************************************************
                    TabloRQ(ComptLigneRQ - 1, 9) = Application.Proper(Format(.Range("E" & ComptLigneRQ), "mmm"))
                    '***Désignation***************************************************************************************
                    TabloRQ(ComptLigneRQ - 1, 10) = Sheets("Mag").Range("B" & ComptLigneMag).Value
                    '***Client**********************************************************************************************
                    TabloRQ(ComptLigneRQ - 1, 11) = Sheets("Mag").Range("Q" & ComptLigneMag).Value
                    '**************************************************************************************************
                    Exit For
                End If
            Next ComptLigneMag
        Next ComptLigneRQ
        .Range("H2").Resize(NbLigneRQ - 1, 11) = TabloRQ
    End With
End Sub
Le 09/09/2013 à 13:42

Bonjour,

Veuillez essayer ce code si (j'ai rajouté la fonction application.Screenupdating = false)

Sub Magasin_Attendus()

Application.Screenupdating=false

    Dim NbLigneRQ, NbLigneMag, ComptLigneRQ, ComptLigneMag As Long
    Dim RefDonnees, RefMag As String
    Dim TabloRQ As Variant
    '**************************************************************************************************
   With Sheets("Données")
        NbLigneRQ = .Range("A" & .Rows.Count).End(xlUp).Row
        NbLigneMag = Sheets("Mag").Range("A" & .Rows.Count).End(xlUp).Row
        .Range("H2:R" & Rows.Count).ClearContents
        ReDim TabloRQ(1 To NbLigneRQ - 1, 1 To 11)
        For ComptLigneRQ = 2 To NbLigneRQ
            RefDonnees = .Range("A" & ComptLigneRQ).Value
            For ComptLigneMag = 2 To NbLigneMag
                RefMag = Sheets("Mag").Range("A" & ComptLigneMag).Value
                If RefMag = RefDonnees Then
                    '***Magasin Attendu********************************************************************************
                   TabloRQ(ComptLigneRQ - 1, 1) = Sheets("Mag").Range("C" & ComptLigneMag).Value
                    '***Emplacement Attendu**************************************************************************
                   TabloRQ(ComptLigneRQ - 1, 2) = Sheets("Mag").Range("D" & ComptLigneMag).Value
                    '***Magasin Du**************************************************************************************
                   TabloRQ(ComptLigneRQ - 1, 3) = Sheets("Mag").Range("E" & ComptLigneMag).Value
                    '***Emplacement Du********************************************************************************
                   TabloRQ(ComptLigneRQ - 1, 4) = Sheets("Mag").Range("F" & ComptLigneMag).Value
                    '***Prix de Vente************************************************************************************
                   TabloRQ(ComptLigneRQ - 1, 5) = Sheets("Mag").Range("H" & ComptLigneMag).Value
                    '***Chiffre d'Affaire***********************************************************************************
                   TabloRQ(ComptLigneRQ - 1, 6) = .Range("F" & ComptLigneRQ).Value * TabloRQ(ComptLigneRQ - 1, 5)
                    '***Taux MP******************************************************************************************
                   TabloRQ(ComptLigneRQ - 1, 7) = Sheets("Mag").Range("S" & ComptLigneMag).Value
                    '***Cout MP******************************************************************************************
                   TabloRQ(ComptLigneRQ - 1, 8) = TabloRQ(ComptLigneRQ - 1, 6) * TabloRQ(ComptLigneRQ - 1, 7)
                    '***Mois***********************************************************************************************
                   TabloRQ(ComptLigneRQ - 1, 9) = Application.Proper(Format(.Range("E" & ComptLigneRQ), "mmm"))
                    '***Désignation***************************************************************************************
                   TabloRQ(ComptLigneRQ - 1, 10) = Sheets("Mag").Range("B" & ComptLigneMag).Value
                    '***Client**********************************************************************************************
                   TabloRQ(ComptLigneRQ - 1, 11) = Sheets("Mag").Range("Q" & ComptLigneMag).Value
                    '**************************************************************************************************
                   Exit For
                End If
            Next ComptLigneMag
        Next ComptLigneRQ
        .Range("H2").Resize(NbLigneRQ - 1, 11) = TabloRQ
    End With
End Sub
Rechercher des sujets similaires à "acceleration traitement"