Optimisation de code VBA

Bonjour à tous,

Je tente actuellement de rendre les données de notre service suivi d'interventions exploitables par TCD (dans la feuille Data)
Pour ce faire, j'ai réalisé un code VBA qui utilise 2 boucles mais ça prend un certain temps avant d'avoir les informations (correctes mais trop long à attendre à mon goût).

N'étant pas du tout développeur, je suis déjà plutôt content de parvenir au bon résultat mais je me doute qu'il y a moyen de faire mieux.

Voici le code :

i représente les colonnes de dates d'intervention

j représente les postes d'intervention

Sub Analyse()

Application.ScreenUpdating = False

Sheets("Data").Activate
    Cells.Select
    Selection.ClearContents
    Cells(1, 1).Value = "DateIntervention"
    Cells(1, 2).Value = "Zone"
    Cells(1, 3).Value = "Sous-Zone"
    Cells(1, 4).Value = "Travail"
    Cells(1, 5).Value = "Quantité"
    Cells(1, 6).Value = "Unité"
    Cells(1, 7).Value = "Prix"
    Cells(1, 8).Value = "Total€"
    Cells(1, 9).Value = "NumPoste"
    Cells(1, 10).Value = "Poste"
    Cells(1, 11).Value = "ErreurPrixouNbUnité"
Sheets("planning.").Activate

For i = 16 To 25
    For j = 9 To 2500
        If Cells(j, i).Value = "" Then

        Else
            numposte = Cells(j, 1).Value
            poste = Cells(j, 2).Value
            zone = Cells(j, 8).Value
            souszone = Cells(j, 9).Value
            travail = Cells(j, 10).Value
            datum = Cells(j, i).Value
            unit = Cells(j, 11).Value
            nbunit = Cells(j, 12).Value

            prix = Cells(j, 46).Value

            If prix = "" Then
             prix = 0
            End If
            If nbunit = "" Then
                nbunit = 0
            End If

            Total = nbunit * prix

            Sheets("Data").Activate

            derniereLigne = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(derniereLigne, 1).Value = datum
            Cells(derniereLigne, 2).Value = zone
            Cells(derniereLigne, 3).Value = souszone
            Cells(derniereLigne, 4).Value = travail
            Cells(derniereLigne, 5).Value = nbunit
            Cells(derniereLigne, 6).Value = unit
            Cells(derniereLigne, 7).Value = prix
            Cells(derniereLigne, 8).Value = Total
            Cells(derniereLigne, 9).Value = numposte
            Cells(derniereLigne, 10).Value = poste
            If prix = 0 Then
                Cells(derniereLigne, 11).Value = "Pas de prix"
            End If

            If nbunit = 0 Then
                Cells(derniereLigne, 11).Value = "Pas de quantité"
            End If

            If nbunit = 0 And prix = 0 Then
                Cells(derniereLigne, 11).Value = "Pas de prix et pas de quantité"
            End If

            Sheets("planning.").Activate
        End If
    Next
Next

MsgBox ("Opération terminée")
'
End Sub

Quelqu'un aurait-il une idée à me proposer?

D'avance merci pour votre retour et excellente journée.

Bonjour,

Oui j'ai plusieurs idées d'améliorations:

Utiliser des tableaux VBA plutôt que de passer par les valeurs de cellules, ça accélérera les calculs, voir exemple ici: https://www.excel-pratique.com/fr/vba/tableaux_vba

Supprimer les instructions inutiles, par exemple je vois dans le code:

If prix = "" Then
    prix = 0
End If
If nbunit = "" Then
    nbunit = 0
 End If

Je ne pense pas que ce soit nécéssaire de faire ça, si les cellules sont vides, le total sera déjà égal à 0 car "" va automatiquement être converti en 0, sinon pour être sûr de travailler avec des nombres on peut écrire ça en début de code:

Dim prix as Double, nbunit as Double

Éviter trop d'opérations intermédiaires, au lieu d'écrire ça:

numposte = Cells(j, 1).Value
Cells(derniereLigne, 9).Value = numposte

On peut écrire:

Cells(derniereLigne, 9).Value = Cells(j, 1).Value

Sortir les éléments qui n'ont rien à faire dans la boucle, dans la boucle tu as mis:

derniereLigne = Cells(Rows.Count, 1).End(xlUp).Row + 1

Selon moi, tu peux initialiser cette variable avant de rentrer dans la boucle, puis à chaque fois que tu arrives vers la fin de la boucle, avant de boucler à nouveau, tu incrémentes la valeur comme ceci:

derniereLigne  = derniereLigne  + 1

Je vois aussi qu'il y a des lignes de code pour activer les feuilles à tour de rôle, c'est plus simple d'écrire ça à la place:

With Sheets("Data")
    .Cells.ClearContents
    .Cells(1, 1).Value = "DateIntervention"
    .Cells(1, 2).Value = "Zone"
    .Cells(1, 3).Value = "Sous-Zone"
    .Cells(1, 4).Value = "Travail"
    .Cells(1, 5).Value = "Quantité"
    .Cells(1, 6).Value = "Unité"
    .Cells(1, 7).Value = "Prix"
    .Cells(1, 8).Value = "Total€"
    .Cells(1, 9).Value = "NumPoste"
    .Cells(1, 10).Value = "Poste"
    .Cells(1, 11).Value = "ErreurPrixouNbUnité"
End With

Un autre moyen d'accélérer l'éxécution du code c'est d'utiliser ceci en début de code:

Application.ScreenUpdating = False

Comme Excel ne va pas essayer de mettre à jour l'affichage en permanence, il aura plus de ressources pour traiter la macro.

Petite amélioration également pour un des test qui est fait, au lieu d'écrire:

If Cells(j, i).Value = "" Then

Else
    'code
End If

On peut simplement faire:

If Not Cells(j, i).Value = "" Then
    'code
End If

Je n'ai peut-être pas pensé à toutes les améliorations possibles, mais selon moi, celle qui aura le plus gros impact c'est l'utilisation de tableaux VBA.

Bonjour !

J'étais en train d'écrire sensiblement les mêmes choses. Je laisse Ausecours traiter tout ceci :)

J'aurais aussi typé les variables prix et nbunit en Currency (ou double). Ainsi, si la cellule est vide, la valeur se met à 0 automatiquement et évite de devoir faire les 2 conditions ensuite. J'ignore l'impact niveau temps que cela peut avoir.

Bonjour 21Formatic!

J'espère avoir réussi à me rappeler de tout ce que je voulais dire, visiblement intégration de code + liste ordonnée = une partie du message qui disparait!

Je vais tenter de bien traiter ça alors!

Merci pour toutes les remarques constructives Ausecour.

J'ai modifié tout sauf l'utilisation des tableaux parce que je ne comprends pas. Tu sais m'en dire plus?

Malheureusement, je n'ai plus aucun contenu

Dim prix As Currency, nbunit As Double

Application.ScreenUpdating = False

With Sheets("Data")
    .Cells.ClearContents
    .Cells(1, 1).Value = "DateIntervention"
    .Cells(1, 2).Value = "Zone"
    .Cells(1, 3).Value = "Sous-Zone"
    .Cells(1, 4).Value = "Travail"
    .Cells(1, 5).Value = "Quantité"
    .Cells(1, 6).Value = "Unité"
    .Cells(1, 7).Value = "Prix"
    .Cells(1, 8).Value = "Total€"
    .Cells(1, 9).Value = "NumPoste"
    .Cells(1, 10).Value = "Poste"
    .Cells(1, 11).Value = "ErreurPrixouNbUnité"
End With
Sheets("planning").Activate

For i = 16 To 25
    For j = 9 To 2500
        If Not Cells(j, i).Value = "" Then

            Sheets("Data").Activate

            derniereLigne = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(derniereLigne, 1).Value = Cells(j, i).Value
            Cells(derniereLigne, 2).Value = Cells(j, 8).Value
            Cells(derniereLigne, 3).Value = Cells(j, 9).Value
            Cells(derniereLigne, 4).Value = Cells(j, 10).Value
            Cells(derniereLigne, 5).Value = Cells(j, 12).Value
            Cells(derniereLigne, 6).Value = Cells(j, 11).Value
            Cells(derniereLigne, 7).Value = Cells(j, 46).Value
            Cells(derniereLigne, 8).Value = Cells(j, 46).Value * Cells(j, 12).Value
            Cells(derniereLigne, 9).Value = Cells(j, 1).Value
            Cells(derniereLigne, 10).Value = Cells(j, 2).Value
            If prix = 0 Then
                Cells(derniereLigne, 11).Value = "Pas de prix"
            End If

            If nbunit = 0 Then
                Cells(derniereLigne, 11).Value = "Pas de quantité"
            End If

            If nbunit = 0 And prix = 0 Then
                Cells(derniereLigne, 11).Value = "Pas de prix et pas de quantité"
            End If

            Sheets("planning").Activate
        End If
    Next
Next

MsgBox ("Opération terminée")
'
End Sub

Est-ce que tu pourrais mettre le fichier sur le forum pour que je puisse directement intervenir sur le code et le tester? Ce sera peut-être plus simple, si des données sont sensibles, il suffit de les rendre bidon, anonymiser le fichier etc. (Avec l'ancien code si possible).

J'ai dû donner trop d'infos d'un coup et tu t'es emmêlé les pinceaux dans la modification du code

J'ai remis mon code initial dedans et enlever un paquet de lignes...

Mias le principe sera le même

Voici une proposition à partir du fichier fourni:

Le code:

Sub Analyse()
Dim tabData As Variant, tabPlanning As Variant
Dim nbLig As Long, nbCol As Integer, ligTab As Long

Application.ScreenUpdating = False

'réinitialisation de la feuille "Data"
With Sheets("Data")
    .Range("A1").CurrentRegion = ""
    .Cells(1, 1).Value = "DateIntervention"
    .Cells(1, 2).Value = "Zone"
    .Cells(1, 3).Value = "Sous-Zone"
    .Cells(1, 4).Value = "Travail"
    .Cells(1, 5).Value = "Quantité"
    .Cells(1, 6).Value = "Unité"
    .Cells(1, 7).Value = "Prix"
    .Cells(1, 8).Value = "Total€"
    .Cells(1, 9).Value = "NumPoste"
    .Cells(1, 10).Value = "Poste"
    .Cells(1, 11).Value = "ErreurPrixouNbUnité"
End With

tabPlanning = Sheets("planning").Range("A9:AT2500").Value
nbCol = 11

'dimensionnement du tableau Data
nbLig = 0
For lig = LBound(tabPlanning, 1) To UBound(tabPlanning, 1)
    For col = 16 To 25
        If Not tabPlanning(lig, col) = "" Then nbLig = nbLig + 1
    Next col
Next lig
ReDim tabData(1 To nbLig, 1 To nbCol)

'recopie des informations du planning dans le tableau data
ligTab = 0

For lig = LBound(tabPlanning, 1) To UBound(tabPlanning, 1)
    For col = 16 To 25
        If Not tabPlanning(lig, col) = "" Then 'si date alors
            ligTab = ligTab + 1
            tabData(ligTab, 1) = tabPlanning(lig, col) 'date intervention
            tabData(ligTab, 2) = tabPlanning(lig, 8) 'zone
            tabData(ligTab, 3) = tabPlanning(lig, 9) 'sous zone
            tabData(ligTab, 4) = tabPlanning(lig, 10) 'travail
            tabData(ligTab, 5) = CDbl(tabPlanning(lig, 12)) 'quantité
            tabData(ligTab, 6) = tabPlanning(lig, 11) 'unité
            tabData(ligTab, 7) = CCur(tabPlanning(lig, 46)) 'prix
            tabData(ligTab, 8) = tabData(ligTab, 5) * tabData(ligTab, 7)   ' quantité * prix
            tabData(ligTab, 9) = tabPlanning(lig, 1) 'numposte
            tabData(ligTab, 10) = tabPlanning(lig, 2) 'poste

            'gestion des erreurs prix et quantité
            If tabPlanning(lig, 46) = "" And tabPlanning(lig, 12) = "" Then
                tabData(ligTab, 11) = "Pas de prix et pas de quantité"
            ElseIf tabPlanning(lig, 46) = "" Then
                tabData(ligTab, 11) = "Pas de prix"
            ElseIf tabPlanning(lig, 12) = "" Then
                tabData(ligTab, 11) = "Pas de quantité"
            End If

            nbLig = nbLig - 1 'petit optimisation pour ne pas continuer de parcourir le planning si tout est rempli
            If nbLig = 0 Then GoTo fin
        End If
    Next col
Next lig

fin:
'export du tableau data dans la feuille data
Sheets("Data").Range("a2").Resize(UBound(tabData, 1), UBound(tabData, 2)).Value = tabData

Application.ScreenUpdating = True
MsgBox ("Opération terminée")
End Sub

J'ai utilisé With et Sheets().Range pour pouvoir faire appel aux bonnes feuilles peu importe la feuille active en explicitant celle que je voulais utiliser.

J'ai utilisé tabPlanning et tabData pour accélérer l'exécution du code, tabPlanning stocke directement les informations de la plage fournie.

Je parcours une première fois le planning pour savoir combien de lignes d'information le tableau data devra stocker (c'est chiant de travailler avec des tableaux qu'on redimensionne au fur et à mesure donc je préfère avoir la bonne dimension directement).

Ensuite je fais exactement les mêmes boucles pour remplir le tableau dimensionné qui est tout vide.

J'ai mis directement dans le tabData les infos du tabPlanning quand c'était possible, pour le total j'utilise les données stockées dans tabData qui ont été converties quelques lignes de code avant avec CDbl et CCur.

Pour la gestion des erreurs je fais un Seul If...ElseIf...End If, l'ordre dans lequel j'ai écris les conditions est important.

j'utilise de nouveau la variable nbLig que je décrémente à chaque fois qu'une ligne est remplie, on peut ainsi facilement suivre le nombre de lignes qu'il reste à remplir, une fois que tout est rempli elle est égale à 0. Je teste si c'est le cas, et j'utilise Goto fin pour sortir de la boucle et passer à l'export du résultat. Je réactive ensuite la mise à jour de l'affichage avant que la MsgBox ne s'affiche, sinon ça affiche un message disant que l'opération est terminée mais on ne voit pas encore le résultat dans la feuille Data, ce qui donne l'impression que ça n'a pas marché. Vu que l'affichage se met à jour avant, on voit le résultat et le message.

Si tu as des questions en plus sur ce que j'ai utilisé n'hésites pas à demander.

bonjour le fil,

optimalisation mineur

With Sheets("Data").Range("A1")
     .CurrentRegion.ClearContents
     .Resize(, 11).Value = Array("DateIntervention", "Zone", "Sous-Zone", "Travail", "Quantité", "Unité", "Prix", "Total€", "NumPoste", "Poste", "ErreurPrixouNbUnité")     'en une fois
End With

2ième correction, plus dangeureux, dès que je vois des dates ou des valeurs "currency", j'utilise ".value2" au lieu de ".value". Je n'ai pas fait les teste ici, mais sans ce "2", VBA arrondi parfois les valeur ( 2 chiffres après la virgule) et les dates ...???

tabPlanning = Sheets("planning").Range("A9:AT2500").Value2

Bonjour BsAlv et merci pour ta contribution, je ne savais pas du tout que Value arrondissait parfois les valeurs, tu m'apprends un truc

PS: j'ai l'impression que ça dit l'inverse sur le site de microsoft...

"La seule différence entre cette propriété et la propriété Value est que la propriété Value2 n’utilise pas les types de données Monétaire et Date . Vous pouvez retourner des données de ce type sous forme de nombres à virgule flottante en utilisant le type de données Double."

Source: https://docs.microsoft.com/fr-fr/office/vba/api/excel.range.value2

Je lis mal? ça me semble bien pourtant bien d'utiliser le type de données monétaire et date quand c'est ce genre de données que l'on trouve...

Re,

Et une version sans tableau, plus proche de ce que tu avais fait.

Je suis plus qu'ouvert à toute optimisation. (j'ai déjà intégré la simplification de BsAlv)

Sub Analyse()
Dim prix As Currency, nbunit As Double, Ws1 As Worksheet, Ws2 As Worksheet

Set Ws1 = Sheets("Planning")
Set Ws2 = Sheets("Data")
Application.ScreenUpdating = False

With Ws2.Range("A1")
     .CurrentRegion.ClearContents
     .Resize(, 11).Value = Array("DateIntervention", "Zone", "Sous-Zone", "Travail", "Quantité", "Unité", "Prix", "Total€", "NumPoste", "Poste", "ErreurPrixouNbUnité")     'en une fois
End With

For i = 16 To 25
    For j = 9 To 2500
If Not Ws1.Cells(j, i).Value = "" Then
    With Ws1
        nbunit = .Cells(j, 12).Value
        prix = .Cells(j, 46).Value

derniereLigne = Ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Ws2.Cells(derniereLigne, 1).Value = .Cells(j, i).Value
    Ws2.Cells(derniereLigne, 2).Value = .Cells(j, 8).Value
    Ws2.Cells(derniereLigne, 3).Value = .Cells(j, 9).Value
    Ws2.Cells(derniereLigne, 4).Value = .Cells(j, 10).Value
    Ws2.Cells(derniereLigne, 5).Value = nbunit
    Ws2.Cells(derniereLigne, 6) = .Cells(j, 11).Value
    Ws2.Cells(derniereLigne, 7) = prix
    Ws2.Cells(derniereLigne, 8).Value = nbunit * prix
    Ws2.Cells(derniereLigne, 9).Value = .Cells(j, 1).Value
    Ws2.Cells(derniereLigne, 10).Value = .Cells(j, 2).Value

        If nbunit = 0 And prix = 0 Then
            Ws2.Cells(derniereLigne, 11).Value = "Pas de prix et pas de quantité"
        ElseIf prix = 0 Then
            Ws2.Cells(derniereLigne, 11).Value = "Pas de prix"
        ElseIf nbunit = 0 Then
            Ws2.Cells(derniereLigne, 11).Value = "Pas de quantité"
        End If
    End With
Else: End If
    Next
Next

MsgBox ("Opération terminée")
End Sub

Salut Finplein,
Salut l'équipe,

premier jet...

Sub Analyse()
'
Dim tTab, tOut, iPos%
'
Application.ScreenUpdating = False
'
With Worksheets("Planning")
    iRow = WorksheetFunction.CountA(.Range("P9:Y" & .UsedRange.Rows.Count))
    tTab = .Range("A9:AT" & .UsedRange.Rows.Count).Value
End With
With Worksheets("Data")
    .Cells.Delete
    tOut = .Range("A1:K" & iRow + 1).Value
    For x = 1 To 11
        tOut(1, x) = Choose(x, "DateIntervention", "Zone", "Sous-Zone", "Travail", "Quantité", "Unité", "Prix", "Total€", "NumPoste", "Poste", "ErreurPrixouNbUnité")
    Next
    For x = 16 To 25
        For y = 1 To UBound(tTab, 1)
            If tTab(y, 8) <> "" And tTab(y, 10) <> "" And tTab(y, x) <> "" Then
                iPos = IIf(iPos = 0, 2, iPos + 1)
                For Z = 1 To 10
                    tOut(iPos, Z) = tTab(y, Choose(Z, x, 8, 9, 10, 12, 11, 46, 1, 1, 2))
                Next
                tOut(iPos, 1) = CDate(tTab(y, x))
                If tTab(y, 12) = "" Then tOut(iPos, 5) = 0
                If tTab(y, 46) = "" Then tOut(iPos, 7) = 0
                tOut(iPos, 8) = CDbl(tOut(iPos, 5)) * CDbl(tOut(iPos, 7))
                If tOut(iPos, 5) = 0 And tOut(iPos, 7) = 0 Then
                    tOut(iPos, 11) = "Pas de prix et pas de quantité"
                Else
                    tOut(iPos, 11) = "Pas de " & IIf(tOut(iPos, 5) = 0, "quantité", "prix")
                End If
            End If
        Next
    Next
    .Range("A1").Resize(UBound(tOut, 1), 11).Formula = tOut
    .Activate
End With
'
End Sub

Je revérifie..

A+

Petite correction

                If CDbl(tOut(iPos, 5)) = 0 And CDbl(tOut(iPos, 7)) = 0 Then
                    tOut(iPos, 11) = "Pas de prix et pas de quantité"
                Else
                    If CDbl(tOut(iPos, 5)) = 0 Or CDbl(tOut(iPos, 7)) = 0 Then _
                        tOut(iPos, 11) = "Pas de " & IIf(CDbl(tOut(iPos, 5)) = 0, "quantité", "prix")
                End If

Un double-clic sur la feuille 'Planning' démare la macro "Analyse", en Module1.

A+

Merci à tous.

C'est impressionnant cette différence de temps gagnée avec l'utilisation du tableau.

J'avoue ne pas avoir compris le code mais je vais tenter de déchiffrer tout ça !

Un tout grnad merci à tous pour vos interactions sur ma demande. Vous êtes au top.

Si tu essayes avec ma version, ça te fait gagner du temps quand même ? (juste pour info)

Mais sinon oui, l'utilisation des tableaux est toujours un gain de temps. Enfin, surtout quand on est Curulis et qu'on pond ça en 2 minutes... Grrrrr

Ah, ah, BientôtNoël, 2' ! Que nenni !
Appelé à gauche, à droite et absent d'Excel depuis des mois, il m'a fallu bien plus de temps pour retrouver mes habitudes!

Toujours en pleine forme, camarade ?

Bah écoute oui, ça va. Et toi ?

Je n'ai pas remarqué que tu n'étais pas là, ne passant plus trop de mon côté non plus ...

As-tu des nouveautés à nous partager concernant Curulis Quest ?

Oui, il a fallu une plombe sans fin pour obtenir les fichiers 3D pour l'imprimante mais on s'approche du bout du tunnel.
Dans quelques jours, je publierai une vue d'ensemble d'un échiquier complet.

Bonjour le fil,

@AuSecours, en annexe 2 colonne, la première des dates, la 2ième du currency. Si je lis cela dans une matrice et puis je la colle, les dates sont okay, mais certains valeurs de currency sont arrondi, mais il y a une chose que je ne savais pas avant

* colonne D:E = lu comme value et collé comme value = comme prévu currency arrondi à 2 chiffres

* colonne G:H = lu comme value2 et collé comme value = tout okay

* une fantasie (ca, je n'ai jamais fait avant) : colonne J:K = lu comme value et collé comme value2 = currency arrondi à 4 chiffres !!!???

Explication/Constatation : quand on est en debug-mode et inspecte le contenu de aa1, 2ième colonne les valeurs douteux sont type variant/currency arrondi à 4 chiffres, donc il y a déjà des pertes d'accurance (minimal) après la première lecture. En collant comme .value, une nouvelle arrondissement (à 2 chiffres) apparait.

Quand je demande cela à mon ami Google, il avait vu la même chose ( https://fastexcel.wordpress.com/2011/11/30/text-vs-value-vs-value2-slow-text-and-how-to-avoid-it/), je me demande que dans le future, je doit toujours utiliser "Value2", c'est plus vite et plus juste

Sub teste()
     With Range("A1").CurrentRegion
          aa1 = .Value     'lire methode "Value"
          .Offset(, 3).Value = aa1

          aa2 = .Value2     'lire methode "Value2"
          .Offset(, 6).Value = aa2

          .Offset(, 9).Value2 = aa1     'étant lu comme "Value" mais collé comme "Value2" ?????

          .Offset(, 12).Value2 = aa2
     End With
End Sub

Rebonjour,

Ah oui en effet, Value massacre les virgules...

Bon ben à l'avenir j'utiliserai plutôt Value2 alors, je me demandais justement à quoi servait Value2, maintenant je saurai