Accélérer l'exécution code VBA sur Excel

Le 08/11/2019 à 11:58

Bon voila un VBA qui fonction très bien juste il est lent; je utilise deux SpinButton Un pour inséré l’Année dans la cellule ‘A2’ et le 2eme pour insérer le mois dans la cellule ‘A1’ pour afficher le détail des sortie journalier de tt le mois de l’année sélection insérer dans la cellule ‘A2’ comme sur l’image en bas du message.

1573141376772

1_Mon bute et de rendre le code souple durant son exécution

2_ supprimer les deux SpinButton a fin d'inséré directement l’année et le mois par clavier dans les deux cellule A1 et A2 pour afficher le détail des sorties journalier du mois

voila mon code et merci pour vous

VB:

Private Sub SpinButton1_Change()

monmois = Range("AC1")
If monmois = "" Then Exit Sub
If monmois > 12 Then Exit Sub
Annee = Worksheets("Detailsortie").Range("A2").Value
If Annee = 0 Then
        MsgBox "SVP!Entrer Une Année en Numérique Dans la Cellule A2'Consommation' !"
        Exit Sub
    End If
Range("a1") = Choose(monmois, "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
Range("A1:AG1").Select
col = Choose(monmois, 33, 34, 35, 36, 37, 38, 39, 40, 24, 19, 42, 44)
    Selection.Interior.ColorIndex = col

 Range("A4:AF2000").ClearContents
    With Sheets("Action")
        For Ln = 2 To .Range("B" & Rows.Count).End(xlUp).Row
            If Month(.Range("C" & Ln)) = monmois And Year(.Range("C" & Ln)) = Annee Then
                If .Range("B" & Ln) = "Sortie" Then
                    j = Day(.Range("C" & Ln))
                    Set Cell = Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row).Find(.Range("F" & Ln), lookat:=xlWhole)
                    If Not Cell Is Nothing Then
                        lgn = Cell.Row
                    Else
                        lgn = Range("A" & Rows.Count).End(xlUp)(2).Row
                    End If
                    Range("A" & lgn) = .Range("F" & Ln)
                    Cells(lgn, j + 1).Value = Cells(lgn, j + 1).Value + .Range("G" & Ln)
                End If
            End If
        Next Ln
    End With
End Sub

Private Sub SpinButton2_Change()

myyear = Range("B2")
If myyear = "" Then Exit Sub

Range("A2") = Choose(myyear, "2014", "2015", "2016", "2017", "2018", "2019", "2020", "2021", "2022", "2023", "2024", "2025", "2026 ")
Range("A2").Select
col = Choose(myyear, 33, 34, 35, 36, 37, 38, 39, 40, 24, 19, 42, 44)
End Sub

Mille fois merci

Le 08/11/2019 à 13:27

Bonjour Cavila, bonjour le forum,

je pense qu'on pourrait accélérer l'exécution du code en travaillant non pas sur les cellules directement mais plutôt sur des variables tableau représentant les plages. Je ne peux malheureusement pas fonctionner sans le fichier mais le principe est relativement simple. On définit une variable de type variant et on la définit, par exemple :

Dim TV As Variant
TV = Sheets("Action").Range("A1").CurrentRegion

Le nombre de lignes de TV est égal à UBound(TV, 1) et le nombre de colonnes à UBound(TV, 2), la valeur d'une cellule ne se fait plus par Range(Colonne/Ligne) ou Cells(Ligne/Colonne) mais par TV(ligne/colonne). C'est pratiquement identique sauf que c'est beaucoup plus rapide en lecture. Si tu mets un fichier exemple en pièce jointe je pourrai te monter plus précisément et surtout, adapté à ton cas...

Le 08/11/2019 à 14:13

bsr voila l'éxemple

10fon.zip (24.37 Ko)
Le 08/11/2019 à 19:43

Re,

Je n'ai pas vu de différence notoire entre ta méthode et la mienne sur l'exemple fourni ! Je pense que tes MFC retardent un peu l'affichage mais le tableau est tellement petit...

À tester sur ton vrai tableau qui doit-être plus conséquent.

Le code (choisis un mois ou tape une année) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MC As Integer 'déclare la variable MC (Mois en Chiffre)
Dim DD As Date 'déclare la variable DD (Date de Début)
Dim DF As Date 'déclare la variable DF (Date de Fin)
Dim OM As Worksheet 'déclare la variable OM (Onglet Mouvement)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D1 As Object 'déclare la variable D1 (Dictionnaire 1)
Dim D2 As Object 'déclare la variable D2 (Dictionnaire 2)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP1 As Variant 'déclare la variable TMP1 (tableau TeMPoraire 1)
Dim J As Integer 'déclare la variable I (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TMP2 As Variant 'déclare la variable TMP2 (tableau TeMPoraire 2)
Dim TPED() As Variant 'déclare la variable TPED (Tabbleau des Produits Et Dates)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim COUL As Integer 'déclare la variable COUL (COULeur)

'si le changement a lieu ailleurs qu'en A1 ou A2, sort de la procédure
If Application.Intersect(Target, Range("A1:A2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Range("B4:AF19").ClearContents 'efface d'éventuelles anciennes données
MC = CInt(Format("1/" & Range("A1").Value & "/2019", "mm")) 'définit le mois en chiffre MC
DD = DateSerial(Range("A2").Value, MC, 1) 'définit la date de début DD, le premier jour du mois
DF = DateSerial(Range("A2").Value, MC + 1, 0) 'définit la date de fin DF, le dernier jour du mois
Set OM = Worksheets("Mouvement") 'définit l'onglet OM
TV = OM.Range("A1").CurrentRegion 'définit le tableau des valeurs TV (pas très malin cette colonne A presqu'invisible !)
Set D1 = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D1
Set D2 = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D2

'*******************************************************************************
'cette partie permet de répertorier les produits dans le tableau temporaire TMP1
'*******************************************************************************
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableauD2 des valeurs TV (en partant de la seconde)
    D1(TV(I, 6)) = "" 'alimente le dictionnaire D1 avec les données de la colonne 6 de TV
Next I 'prochaine ligne de la boucle
TMP1 = D1.Keys 'alimente le tableau temporaire TMP1 avec la liste des élément de D1 sans doublons
'*******************************************************************************

'******************************************************************************************************
'cette partie permet de répertorier les différentes dates de chaque produit et de créer le tableau TPED
'******************************************************************************************************
For J = 0 To UBound(TMP1) 'boucle 1 : sur tous les produits du tableau temporaire TMP1
    L = 1 'initialise la variable L
    Erase TPED 'vide le tableau TPED
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        DL = DateSerial(Year(TV(I, 3)), Month(TV(I, 3)), Day(TV(I, 3))) 'définir la date de la ligne DL
        'condition 1 : si le produit de la boucle 1 (TMP1(J)) est égal au produit de la boucle 2 (ligne I, colonne 6) de TV
        If TMP1(J) = TV(I, 6) Then
            If DL >= DD And DL <= DF Then 'Condition 2 : si DL est comprise entre la date de début et la date de fin
                D2(TV(I, 3)) = "" 'alimente le dictionnaire D2 avec les données en colonne 3 de TV
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next I 'prochaine ligne de la boucle 2
    If D2.Count = 0 Then 'condition : si aucune date n'est comprise entre DB et DF
        MsgBox "Aucune sortie pour ce mois !"
        GoTo Couleur 'va '`a l'étiquette "Couleur"
    End If 'fin de la condition
    TMP2 = D2.Keys 'définit le tableau temporaire TMP2 avec la liste des élément du dictionnaire 2 sans doublons (les date du produit)
    For K = 0 To UBound(TMP2) 'boucle 3 sur toutes les dates du tableau temporaire TMP2
        ReDim Preserve TPED(1 To 2, 1 To L) 'redimensionne le tableau TPED (2 lignes, K colonnes)
        TPED(1, L) = TMP1(J) 'récupère dans la ligne 1 colonne K de TPED le prodtuit TMP()J)
        TPED(2, L) = TMP2(K) 'récupère dans la ligne 2 colonne K de TPED la date TMP(K) du produit
        L = L + 1 'incrémente L (ajoute une colonne au tableau TPED)
    Next K 'prochaine date de la boucle 3
    For N = 1 To UBound(TPED, 2) 'boucle 4 : sur tous les couples Produit/Date du tableau TPED
        For I = 2 To UBound(TV, 1) 'boucle 5 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
            If TV(I, 3) = TPED(2, N) And TV(I, 6) = TPED(1, N) Then 'condition : si produit et date concordent
                COL = CInt(Split(TPED(2, N), "/")(0)) + 1 'définit la colonne COL (récupère les caractères avant le premier /)
                LI = Columns(1).Find(TPED(1, N), , xlValues, xlWhole).Row 'définit la ligne LI
                'additionne à la cellule ligne LI colonne COL la donnée ligne I colonne 7 de TV
                Cells(LI, COL).Value = Cells(LI, COL).Value + TV(I, 7)
            End If 'fin de la condition
        Next I 'prochaine ligne de la boucle 5
    Next N 'prochain couple de la boucle 4
Next J 'prochain produit de la boucle 1
Couleur: 'étiquette
COUL = Choose(MC, 33, 34, 35, 36, 37, 38, 39, 40, 24, 19, 42, 44) 'définit la couleur COUL
Range("A1:AG1").Interior.ColorIndex = COUL 'applique la couleur COUL à la plage A1:AG1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Le fichier :

10cavila-ep-v01.zip (27.21 Ko)
Le 08/11/2019 à 20:11

bonsoir; merci maintenant les résultats s'affiche rapidement mais y a deux petits problèmes un Quand je choisie un Mois ou je n'est pas fait de sortie il dois rien a afficher sur la colonne 'A4:A' de Feuil1

deux Quand j'ajoute une nouvelle sortie avec un nouveau produit il l'affiche pas sur la colonne A4 de la Feuil1 après avoir ajouter le mois A1 et l'année A2 et il me fait aparetre un code erreur ' variable objet ou variable de bloc with non définie

Merci

Le 08/11/2019 à 23:15

Re,

Ok por le premier point je résoudrai ça demain. Quant au second, quel est le numéro de l'erreur et la ligne qui bugue ?

Le 08/11/2019 à 23:37

bonsoir, erreurs d'exécution n°19

LI = Columns(1).Find(TPED(1, N), , xlValues, xlWhole).Row 'définit la ligne LI

bonne nuit

Le 09/11/2019 à 00:55

Re,

La version 02 devrait convenir... Bonne nuit aussi !

8cavila-ep-v02.zip (24.27 Ko)
Le 09/11/2019 à 10:11

bonjour ThauThème avant tout mille fois merci et je tien vraiment a m'excuser de vous avoir déranger si deux dernier jour, voila sa fonction et ça me conviens très bien juste un dernier détail peut on ajouter une ligne de code pour que le résultats final bien sur après avoir ajouter " mois"A1" et année "A2"' affiche uniquement le détail des "Sortie "B"Mouvement" son prendre en compte les "Entrée "B"Mouvement" comme ça était dans le code de mon projet poster précédemment voila un bout de code

Range("A4:AF2000").ClearContents
    With Sheets("Mouvement")
        For Ln = 2 To .Range("B" & Rows.Count).End(xlUp).Row
            If Month(.Range("C" & Ln)) = monmois And Year(.Range("C" & Ln)) = Annee Then
                If .Range("B" & Ln) = "Sortie" Then
                    j = Day(.Range("C" & Ln))
                    Set Cell = Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row).Find(.Range("F" & Ln), lookat:=xlWhole)
                    If Not Cell Is Nothing Then
                        lgn = Cell.Row

merci et bonne journée

Le 09/11/2019 à 11:16

Bonjour Cavila,

La version 03 en pièce jointe :

2cavila-ep-v03.zip (26.12 Ko)
Le 09/11/2019 à 12:57

bonjour toujours le même problème il affiche toujours les détail des sorties + les détail des entrés je voudrais juste qu'il affiche le détail des sortie de chaque mois de l'année sélectionner si y a possibilité

Le 09/11/2019 à 13:30

Re,

En effet, tu as raison. La version 04 corrigée...

12cavila-ep-v04.zip (26.28 Ko)
Le 09/11/2019 à 15:20

mille fois merci pour ton aide et pour tt le temps que ta consacrée pour moi ThauThème

Le 09/11/2019 à 15:30

Re,

Merci à toi. J'ai aimé ton fichier et surtout la manière de changer de couleur pour chaque mois. Excellente idée !...

Rechercher des sujets similaires à "accelerer execution code vba"