Optimisation de procédure VBA

Bonjour à tous,

J'utilise une procédure VBA qui analyse des données de ventes et crée des commentaires en fonction de ces données

Dans mon exemple chaque cellule de la plage (M2:R10) différente de ‘’---‘’ reçoit un commentaire listant l’ensemble des clients ayant acheté le produit de la même ligne, pour l’année de la même colonne, et trie ces clients par quantités

Le souci c’est que la procédure est très très lente, même pour une petite quantité de données

J’aurais besoin d’une âme charitable pour l'optimiser et réduire considérablement son temps d'exécution

Pour mieux vous rendre compte de ce que fais la procédure est combien de temps elle prend, vous pouvez supprimer l’ensemble des commentaire en (M2:R10) et lancer « RUN MACRO »

Merci d'avance pour votre aide

Bonjour,

Je trouve le code vraiment bien fait. j'imagine même pas le temps pour faire les commentaires sans celle-ci

A mon niveau, j'ai simplement suspendu (durant la macro) les mises à jour de calcul et d'affichage. Sur la plage active, on passe de 36 sec à 24 sec

Je ne sais pas si un tiers du temps c'est "considérable" ? Il y a peut-être d'autres améliorations possibles, mais je ne les maitrise pas

Sub Commentairedynamique()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

    Set ws = ThisWorkbook.Sheets("VB")
    For Each cell In ws.Range("M2:R10")
        If cell.Value <> "---" Then
        annee = ws.Cells(1, cell.Column).Value
        produit = ws.Cells(cell.Row, "L").Value
            If IsNumeric(annee) Then
                If Not cell.Comment Is Nothing Then
                    cell.Comment.Delete
                End If
            Set dictClients = CreateObject("Scripting.Dictionary")
                For i = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                    If ws.Cells(i, "C").Value = annee And ws.Cells(i, "F").Value = produit Then
                        client = ws.Cells(i, "D").Value
                        If dictClients.Exists(client) Then
                            dictClients(client) = dictClients(client) + ws.Cells(i, "H").Value
                        Else
                            dictClients(client) = ws.Cells(i, "H").Value
                        End If
                    End If
                Next i

            ReDim keyValuePairs(0 To dictClients.Count - 1, 0 To 1)
            i = 0

                For Each client In dictClients.Keys
                    keyValuePairs(i, 0) = client
                    keyValuePairs(i, 1) = dictClients(client)
                    i = i + 1
                Next client

                For i = LBound(keyValuePairs, 1) To UBound(keyValuePairs, 1) - 1
                    For j = i + 1 To UBound(keyValuePairs, 1)
                        If keyValuePairs(i, 1) < keyValuePairs(j, 1) Then
                            tempClient = keyValuePairs(i, 0)
                            tempQuantite = keyValuePairs(i, 1)
                            keyValuePairs(i, 0) = keyValuePairs(j, 0)
                            keyValuePairs(i, 1) = keyValuePairs(j, 1)
                            keyValuePairs(j, 0) = tempClient
                            keyValuePairs(j, 1) = tempQuantite
                        End If
                    Next j
                Next i

            commentaire = ""

            For i = LBound(keyValuePairs, 1) To UBound(keyValuePairs, 1)
                commentaire = commentaire & IIf(commentaire = "", "", vbCrLf) & keyValuePairs(i, 0) & " : " & keyValuePairs(i, 1)
            Next i
                If commentaire <> "" Then
                    cell.AddComment commentaire
                    With cell.Comment.Shape.TextFrame
                        .AutoSize = True
                        .Characters.Font.Name = "Calibri"
                        .Characters.Font.Size = 11
                        .Characters.Font.Color = RGB(255, 255, 255)
                        .Characters.Font.Bold = True
                    End With
                    cell.Comment.Shape.Fill.ForeColor.RGB = RGB(0, 50, 100)
                    cell.Comment.Visible = False
                End If
            End If

        End If

        Set dictClients = Nothing

    Next cell

    Set ws = Nothing

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Tu copies/colles le code en lieu et place dans ton module.

Leakim

Bonjour leakim,

Merci d’avoir pris du temps pour me répondre

Les modifications apportées réduisent effectivement le temps d'un tiers sur mon PC aussi, c’est pas mal, mais malheureusement ça n’est pas suffisant pour ce que je souhaite

Dans l'exemple j’ai délibérément fait en sorte que la procédure ne traite que 35 cellules (54 cellules en tout, moins 19 cellules contenant ‘’---‘’)

Mais à terme la procédure devra gérer plus de 3 500 cellules dont environ 2 500 où elle doit placer un commentaire

J’ai déjà essayé de la lancer quelque fois, et cela avait pris entre 25 et 30 minutes pour tout exécuter, c’est beaucoup trop long vu que je dois lancer la procédure plus de 3 fois par jours

J’ai besoin d’un miracle pour transformer ces 30 minutes en quelque seconde

Et en réduisant tes commentaires ? Parce que j'avoue sur 1 cellule il y a une sacrée tartine j'avais essaye avec 1 commentaire d'une ligne il a mis 1.5 sec

L’exemple que j’ai fourni, en plus d’être fictif, et délibérément plus complexe que pour mon vrai fichier de données (les tartines sont bien moins grandes )

Mais cela ne change pas grand-chose, les ordres de grandeur de temps reste les mêmes (17 secondes au lieu de 20 par exemple)

De toute façon je ne peux pas rogner sur le contenu d’un commentaire, le résultat attendu n’aurai plus trop de sens

bonjour,

créer un TCD, cela ne suffit pas et si on veut les details d'un chiffre, on utilise showdetail.

C'est encore excel2019 ou déjà 365 ?

Excel 2019

re,

on n'a plus besoin de cette macro, simplement sélectionner une cellule dans cette plage.

Bonjour,

C'est vrai que le passage par un TCD est une bonne idée. sinon tu as le power BI ou une gestion de ta base en SQL, mais là c'est de la haute voltige... sans moi

Reste que si c'est 3 fois par jour et que tu veux diminuer encore de moitié... tu lances la macro avant une pause

Bonne suite,

Leakim

Et en réduisant tes commentaires ? Parce que j'avoue sur 1 cellule il y a une sacrée tartine j'avais essaye avec 1 commentaire d'une ligne il a mis 1.5 sec

tu as géré par réf ?

Bonsoir tous le monde, oui et la macro était foireuse pour ça que je l'ai pas mis, et aussi essayé en python mais sans succès Par contre BsAlv ta macro chez moi met 31s peu faire mieux

re,

j'étais fainéant, je n'ai pas ajouté des commentaires .

Mon fichier utilise un camera et le contenu du camera change chaque fois on sélectionne une autre cellule de la plage des sommes. Pourquoi ajouter ces commentaires quand cela change 3 fois par jour ??? Un modif du camera est 0.4-0.5 sec.

Bonsoir à tous,

Merci de vous intéresser autant à mon problème c’est top

Même si je ne suis pas très fan des procédures qui se lance à chaque clic, cela me semble être une solution plutôt efficace, en tout cas en comparaison de l’implémentation de millier en commentaires

Je ne connaissais pas du tout cette technique de screen shot merci à toi BsAlv

Merci à tous pour m’avoir aidé

re,

je viens de relever le défi, 200 sec pour 76 lignes * 6 cellules = 450 commentaires. Le clou est de copier le commentaire d'une cellule vers les 450 autres cellules, comme ca le font, couleur et size est déjà fixé et on n'a qu'à changer le contenu du commentaire.

La macro "Tous_Les_Commentaires"

Rechercher des sujets similaires à "optimisation procedure vba"