Accelerer Excel macro

[Coubnoob]

Bonjour,

Voila j'ai des macro qui sont assez lourde a executer et j'aimerai savoir si on peut attribuer 100% du processeur a cette tache, en effet pour le moment je met 2 min pour 208 données et il faudrait que ca soit (beaucoup) plus bas. J'ai essayer d'alleger le code mais il faudrait que mon proc tourne a fond sur Excel.

Avez vous une idée de comment faire? Au pire si cela bloque mon PC le temps du traitement pas de probléme

Merci
Bonne journée

 

[Excel-lent]

Re : Accelerer Excel macro

Salut Coubnoob,

Utilise le moteur de recherche du forum, j'ai déjà vu cette question il y a quelque temps. Et le "questionneur" de l'époque avait obtenu plusieurs réponses intéressantes.

Bonne recherche

PS : désolé, mais n'étant pas intéressé par le sujet, je n'ai pas retenu les réponses.

 

[flyonets44]

Re : Accelerer Excel macro

Bonjour
tu places ce code en début de macro, à condition de ne pas faire appels aux fonctions natives d'excel

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ton code

et celui-ci en fin de macro
Application.Calculation = xlCalculationautomatic
end sub

Cordialement
flyonets

 

[Coubnoob]

Re : Accelerer Excel macro

Bonjour,

Excel-lent, j'ai regardé un peu mais c'est au cas par cas les sujets( enfin de ce que j'ai trouvé)

J'utilise les fonctions Average et Abs de Excel dans mon VBA. Voici la partie qui est lente. En effet j'ai 3 parametre dans mes calculs et chaqu'un varie de 0.1 a 0.9 avec des pas de 0.1 (enfin normalement mais j'ai diminué un peu mais ca ne suffit toujours pas...)

La difficulté commence a 'Calcul des differentes valeurs , avant aucune optimisation n'est necessaire, le temps est respectable

Sub Mul()

    Dim i As Long
    Dim j As Long
    Dim c As Long
    Dim z As Long
    Dim piece As Long
    Dim Cpt As Long
    z = 1
    i = 4
    j = 0
    piece = 0
    i = 3
    pb = 2
    Tendiv = 2

    Application.ScreenUpdating = False
    Do While i < 81                                     'Rentre les periodes
        Sheets("Multi").Cells(1, i) = z
        z = z + 1
        i = i + 1
    Loop
    Sheets("Multi").Cells(1, 1) = "Periode"                             'Legende
    Sheets("Multi").Cells(2, 1) = "Nb parts"
    z = 6
    i = 4
    pb = 0
    Do While i < 100000                                    'Rentre les données
        go = 0
        colonne = 3
        If Not IsEmpty(Sheets("Page1_1").Cells(i, 2)) Then                 'Prend selement les lignes avec des données
            For c = 3 To 62
                toto = Sheets("Page1_1").Cells(i, c)
                If (toto <> 0) Then                 'Detecte si une piece a une mise en route < 60 mois
                    go = 1
                End If
                If (go = 1) Then                    'Si la piece a un go a 1 alors la demande est >0 donc on la met
                    Sheets("Multi").Cells(z, colonne) = toto
                    colonne = colonne + 1
                End If
            Next c
            toto = Sheets("Page1_1").Cells(i, 1)
            If (colonne >= 33) Then
                Sheets("Multi").Cells(z, 2) = colonne - 3        'Rentre le nombre de mois qui est dans l'historique
                Sheets("Multi").Cells((z + 1), 2) = toto
                If (go <> 0 & Sheets("Multi").Cells(z, 6) <> "") Then
                    piece = piece + 1
                    Sheets("Multi").Cells(z, 1) = "D" & piece
                    z = z + 1
                    Sheets("Multi").Cells(z, 1) = "F" & piece
                    z = z + 1
                    Sheets("Multi").Cells(z, 1) = "T" & piece
                    z = z + 1
                    Sheets("Multi").Cells(z, 1) = "C" & piece
                    z = z + 1
                    Sheets("Multi").Cells(z, 1) = "f" & piece
                    z = z + 2
                End If
            End If
            If colonne < 33 Then
                pb = pb + 1
                Sheets("Dmd0").Cells(pb, 3) = toto
            End If
    End If
    i = i + 1
    Loop                                                                'Données dans le tableau
    
    Sheets("Multi").Activate
    Sheets("Multi").Cells(2, 2) = piece                                   'Nombre de piece dans la feuille Expo
    For i = 1 To piece
        c = i * 6
        j = (i * 6) + 1
        Sheets("Multi").Select
        Cells(j, 14) = WorksheetFunction.Average(Range(Cells(c, 3), Cells(c, 14)))      'Calcul de la moyenne sur l'année la plus loin
        j = j + 1
        Sheets("Multi").Cells(j, 14) = 0                            'Tendance a 0 pour la 1er valeur de la T
        j = j + 1
        For l = 3 To 14
            Sheets("Multi").Cells(j, l) = 1                     'Calcul du coef de saisonalité
        Next l
    Next i                                      'Mise en place des coefs
    Sheets("Multi").Activate

    
    Sheets("Multi").Activate
    For i = 1 To piece              'Calcul des differentes valeurs
        Alpha = 0.1
        Beta = 0.1
        Gamma = 0.2
        Best = 9999999999#
        go = i * 6
        Do While Beta < 0.5
            Do While Gamma < 0.91
                Do While Alpha < 0.91
                    For j = 15 To (Cells(go, 2) - 16)
                        Sheets("Multi").Cells((go + 1), j) = ((Alpha * Cells(go, j)) / Cells(go + 3, j - 12)) + ((1 - Alpha) * (Cells(go + 1, j - 1) + Cells(go + 2, j - 1)))    'Calcul de Ft
                        Sheets("Multi").Cells((go + 2), j) = (Beta * (Cells((go + 1), j) - Cells((go + 1), (j - 1))) + ((1 - Beta) * Cells((go + 2), j - 1)))        'Calcul de la Tendance
                        Sheets("Multi").Cells((go + 3), j) = ((Gamma * Cells(go, j)) / Cells((go + 1), j)) + ((1 - Gamma) * Cells(go + 3, j - 12))               'Saisonalité
                    Next j
                    For j = (Cells(go, 2) - 15) To (Cells(go, 2) + 2)
                        If ((Cells(go, 2) + 2) - j) > 5 Then
                            coef = Cells((go + 3), (j - 12))          'Permet de choisir le coef de saiso (12 mois avant)
                        End If
                        If ((Cells(go, 2) + 2) - j) <= 5 Then
                            coef = Cells(go + 3, (j - 24))          ' Coef de saiso 24 mois avant
                        End If
                        toto = ((Cells(go + 1, Cells(go, 2) - 16) + (Cells((go + 2), Cells(go, 2) - 16) / Tendiv * (j - (Cells(go, 2) - 16)))) * coef)
                        If toto > 0 Then    'Valeur positive pour forecast
                            Sheets("Multi").Cells((go + 4), j) = toto
                        Else
                            Sheets("Multi").Cells((go + 4), j) = 0
                        End If
                        
                        If Sheets("Multi").Cells((go + 4), j) = 0 Then
                            If Sheets("Multi").Cells(go, j) = 0 Then
                                Sheets("Multi").Cells(go + 5, j) = 0
                            Else
                                Sheets("Multi").Cells(go + 5, j) = 1
                            End If
                        End If
                        If Sheets("Multi").Cells(go, j) > 0 And Sheets("Multi").Cells(go + 4, j) > 0 Then
                            Sheets("Multi").Cells((go + 5), j) = Math.Abs((Cells(go + 4, j) - Cells(go, j))) / Cells(go, j)
                        End If
                        If (Sheets("Multi").Cells(go, j) = 0 And Sheets("Multi").Cells(go + 4, j) > 0) Then
                            Sheets("Multi").Cells((go + 5), j) = 1
                        End If
                    Next j
                    toto = WorksheetFunction.Average(Range(Sheets("Multi").Cells((go + 5), Sheets("Multi").Cells(go, 2) - 15), Sheets("Multi").Cells(go + 5, Sheets("Multi").Cells(go, 2) + 2)))
                    If toto < Best Then
                        BAlpha = Alpha
                        BBeta = Beta
                        BGamma = Gamma
                        Best = toto
                    End If
                    Alpha = Alpha + 0.2
                Loop
            Gamma = Gamma + 0.2
            Alpha = 0.1
            Loop
        Beta = Beta + 0.2
        Alpha = 0.1
        Gamma = 0.2
        Loop
        Alpha = BAlpha
        Beta = BBeta
        Gamma = BGamma
        Cells(go + 2, 2) = Alpha
        Cells(go + 3, 2) = Beta
        Cells(go + 4, 2) = Gamma
        For j = 15 To (Cells(go, 2) + 2)
            Sheets("Multi").Cells((go + 1), j) = ((Alpha * Cells(go, j)) / Cells(go + 3, j - 12)) + ((1 - Alpha) * (Cells(go + 1, j - 1) + Cells(go + 2, j - 1)))    'Calcul de Ft
            Sheets("Multi").Cells((go + 2), j) = (Beta * (Cells((go + 1), j) - Cells((go + 1), (j - 1))) + ((1 - Beta) * Cells((go + 2), j - 1)))        'Calcul de la Tendance
            Sheets("Multi").Cells((go + 3), j) = ((Gamma * Cells(go, j)) / Cells((go + 1), j)) + ((1 - Gamma) * Cells(go + 3, j - 12))               'Saisonalité
        Next j
        For j = (Cells(go, 2) - 15) To (Cells(go, 2) + 2)
            If ((Cells(go, 2) + 2) - j) > 5 Then
                coef = Cells((go + 3), (j - 12))          'Permet de choisir le coef de saiso (12 mois avant)
            End If
            If ((Cells(go, 2) + 2) - j) <= 5 Then
                coef = Cells(go + 3, (j - 24))          ' Coef de saiso 24 mois avant
            End If
            toto = ((Cells(go + 1, Cells(go, 2) - 16) + (Cells((go + 2), Cells(go, 2) - 16) / Tendiv * (j - (Cells(go, 2) - 16)))) * coef)
            If toto > 0 Then    'Valeur positive pour forecast
                Sheets("Multi").Cells((go + 4), j) = toto
            Else
                Sheets("Multi").Cells((go + 4), j) = 0
            End If
            If Sheets("Multi").Cells((go + 4), j) = 0 Then
                Sheets("Multi").Cells(go + 5, j) = 1
            End If
            If Sheets("Multi").Cells(go, j) > 0 And Sheets("Multi").Cells(go + 4, j) > 0 Then
                Sheets("Multi").Cells((go + 5), j) = Math.Abs((Cells(go + 4, j) - Cells(go, j))) / Cells(go, j)
            End If
            If (Sheets("Multi").Cells(go, j) = 0 And Sheets("Multi").Cells(go + 3, j) > 0) Then
                Sheets("Multi").Cells((go + 5), j) = 1
            End If
        Next j
        For j = (Cells(go, 2) + 3) To (Cells(go, 2) + 2 + 18)
            If (j - Cells(go, 2) + 2) <= 12 Then
                coef = Cells((go + 3), (j - 12))          'Permet de choisir le coef de saiso (12 mois avant)
            End If
            If (j - Cells(go, 2) + 2) > 12 Then
                coef = Cells(go + 3, (j - 22))          ' Coef de saiso 24 mois avant
            End If
            toto = (Cells(go + 2, Cells(go, 2) + 2) / Tendiv)
            toto = toto * (j - (Cells(go, 2) + 2))
            toto = toto + Cells(go + 1, Cells(go, 2) + 2)
            toto = toto * coef
            If toto > 0 Then
                Sheets("Multi").Cells((go + 4), j) = toto
            Else
                Sheets("Multi").Cells((go + 4), j) = 0
            End If
        Next j
    Next i
                     
                    
                   
    For i = 1 To piece
        j = i * 3 + 1
        go = i * 6
        Sheets("Resultats").Cells(j, 5) = Sheets("Multi").Cells(go + 1, 2)
        Sheets("Multi").Activate
        toto = WorksheetFunction.Average(Range(Sheets("Multi").Cells((go + 5), Sheets("Multi").Cells(go, 2) - 15), Sheets("Multi").Cells(go + 5, Sheets("Multi").Cells(go, 2) + 2)))
        Sheets("Resultats").Cells(j, 6) = toto
    Next i
    Application.ScreenUpdating = True
    Sheets("Resultats").Activate
    Sheets("Conclusion").Activate
End Sub

 

[Coubnoob]

Re : Accelerer Excel macro

Up, qq1 a une idée?

Merci