Amélioration macro

Danybrett · 29 Avril 2017

Bonjour,

Ma macro, fonctionne, elle fait ce que je lui demande. Mais elle est extrêmement gourmande et compliquée (1800 lignes de codes) et donc pour éviter que le fichier crash ou que la macro mette 10min à s’exécuter, j'ai passé au début de ma macro en "actualisation manuelle". Comme ça la macro s’exécute en 5 secondes.

Mais du coup quand je viens actualiser les pages manuellement ou si je bascule ma macro en "actualisation automatique" à la fin, ba excel crash. Comme je suis un grand débutant en VBA, ma macro contient sans doute des choses horribles (comme 34 "SI" imbriqué 😛) et j'ai beaucoup utilisé l'enregistrement de macro, il y a donc du code en commentaire dont je ne sais pas ce qu'il fait, mais ça fonctionne sans, donc je ne le mets pas 😛.

J'aimerais savoir si quelqu'un a une idée d'amélioration pour ma macro afin de la fluidifier et qu'elle fonction sur n'importe quel PC même un pas tés puisant (exemple le mien 😛).

Ma macro est basée sur un "Userforme" composé d'un menu déroulant où l'on vient choisir un nouveau produit.
Une fois le choix fait ce nouveau produit vient s'ajouter a liste avec un temps pour chaque opération et une date de début de l'opération.
Ensuite, nous avons plusieurs "centre de charge" qui viennent récupérer les dates et les temps qui les concernent.
la macro vient renseigner le numéro de semaine de chaque date puis elle additionne les temps pour chaque numéro de semaine identique et tout cela est renseigné dans un graphique de charge.

Désolé si ce n'est pas clair, j’espère qu'avec l'Excel fournit vous comprendrez mieux son fonctionnement. 🙂

Lone-wolf · 29 Avril 2017

Bonjour Danybrett et bienvenue sur XLD 🙂, bonjour le Forum 🙂

Il y a quelques corrections à faire dans le code. Ceci par exemple

Sheets("Graph").Select
'Supprimer erreur ou "t" sur centre de charge "A"
Range("A3").Select
ActiveCell.FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
x = Range("A3")

x = Range("D3") à supprimer
For I = 4 To x + 4 à supprimer

With Sheets("Graph")
derlig = .Range("a" & Rows.Count).End(xlUp).row

.Range("a3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
.Range("D3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"

Le reste de code

For i = 4 to 7
If .Range("e" & I) = "t" Or .Range("e" & I) = "T" Then .Range("d4:f7").ClearContents
Next i

.Range("a4:c" & derlig).Sort .Range("b4"), xlAscending
.Range("d4:f" & derlig).Sort .Range("e4"), xlAscending
End With

Danybrett · 29 Avril 2017

Bonjour Lone-wolf et merci de ton accueil et de ta réponse 🙂

Je suis content que tu es compris ma macro, j'ai essayé de l'expliquer à l'oral et j'ai failli ne plus la comprendre moi même 😛

Pour ta modification ce que j'avais fait:

Sheets("Graph").Select
'Supprimer erreur ou "t" sur centre de charge "A"
Range("A3").Select
ActiveCell.FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
x = Range("A3")

For I = 4 To x + 4

If IsError(Range("B" & I)) = True Then
Range("A" & I).ClearContents
Range("C" & I).ClearContents
Range("B" & I).ClearContents
End If

If Range("B" & I) = "t" Then
Range("A" & I).ClearContents
Range("C" & I).ClearContents
Range("B" & I).ClearContents
End If

If Range("B" & I) = "T" Then
Range("A" & I).ClearContents
Range("C" & I).ClearContents
Range("B" & I).ClearContents
End If

Next I

Et je l'ai remplacé par ce que tu m'as donné:

With Sheets("Graph")
derlig = .Range("a" & Rows.Count).End(xlUp).row

.Range("a3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
.Range("D3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"

Le reste de code

For i = 4 to 7
If .Range("e" & I) = "t" Or .Range("e" & I) = "T" Then .Range("d4:f7").ClearContents
Next i

.Range("a4:c" & derlig).Sort .Range("b4"), xlAscending
.Range("d4:f" & derlig).Sort .Range("e4"), xlAscending
End With

Mais le problème est qu'il ne supprime pas le contenue de la case où il y a un "t" ou un "T" ou une erreur (#valeur; #ref; #N/0.....). Je dois sans doute faire quelque chose de mal, mais je ne vois pas :'(

Je vous transmet la maquette Excel avec la modification.

vgendron · 29 Avril 2017

Hello

Effectivement.. c'est un code à rallonge 🙂
pour supprimer tous les if imbriqués qui te permetten de copier coller 3 lignes
et voir mes commentaires en vertmet
et pour éviter que ton écran clignotte (passage d'une feuille à l'autre), un petit
application.enableevents=false en début de macro
et remettre à true en fin de macro

VB:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
ThisWorkbook.Save 'utile je suppose en cas de bug excel?

Application.Calculation = xlCalculationManual
Application.ReferenceStyle = xlA1

Dim I As Long
Dim y As Long
Dim n As Long
Dim no_ligne As Integer

'no_ligne = ComboBox1.ListIndex + 2
NomToAdd = ComboBox1.Value 'on récupère le nom sélectionné dans le ComboBox

'f = Cells(no_ligne, 2) 'sert à quoi?

 'Créer le nouveau produit
With Sheets("Matrice")
    Set ZoneMatrice = .Range("B52:B" & .Range("B" & .Rows.Count).End(xlUp).Row) 'définit la zone B52 à B.... dans la feuille Matrice: celle qui contient les 3 lignes qu'on va devoir copier
    Set c = ZoneMatrice.Find(NomToAdd, lookat:=xlWhole) 'on cherche où se trouve le nom
    If Not c Is Nothing Then
        .Rows(c.Row & ":" & c.Row + 2).Copy 'on récupère les trois lignes
    End If
End With
With Sheets("planning")
    '.Activate
    .Rows("3:5").Insert 'on insert les 3 lignes copiées en haut
    'groupement
    .Rows("4:5").Rows.Group 'on groupe
    With .Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlLeft
    End With
End With
...suite de ton code.. surement optimisable également, mais , j'ai pas encore compris ce que ca faisait

vgendron · 29 Avril 2017

Re
Voici ta macro actualiser_471 revue
voir les commentaires/questions

VB:

Sub actualiser_471()

'ThisWorkbook.Save
'Sheets("Charge 471").Calculate
'Sheets("Graph").Calculate
'Sheets("Graph2").Calculate

Sheets("Graph").Select 'à priori inutile car lancé à partir de la feuille Graph..??
'ActiveSheet.UsedRange.Select

'Supprimer erreur ou "t" sur centre de charge "A"

With Sheets("Graph")
    derlig = .Range("A" & .Rows.Count).End(xlUp).Row 'on récupère la dernière ligne de la colonne A (peut contenir une formule)

    .Range("A3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])" 'on colle en A3 la formule =nbval(B3:B37) pourquoi 37 ?
    .Range("D3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
    .Range("G3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
    .Range("J3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
    .Range("M3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
    .Range("P3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
   
    'Le reste de code

    For I = 4 To 7
        If UCase(.Range("E" & I)) = "T" Then .Range("D4:F7").ClearContents 'on supprime juste les t et T? pas d'erreur? et pas la meme boucle for i que pour les autres charges?
    Next I

    .Range("A4:C" & derlig).Sort .Range("B4"), xlAscending 'tri des colonnes A B et C selon date colonne B = Charge A
    .Range("D4:F" & derlig).Sort .Range("E4"), xlAscending 'tri des colonnes D E et F selon date colonne E = Charge B
    .Range("G4:I" & derlig).Sort .Range("H4"), xlAscending 'tri des colonnes          selon date colonne E = Charge C
    .Range("J4:L" & derlig).Sort .Range("K4"), xlAscending 'tri des colonnes          selon date colonne E = Charge D
    .Range("M4:O" & derlig).Sort .Range("N4"), xlAscending 'tri des colonnes          selon date colonne E = Charge E
    .Range("P4:R" & derlig).Sort .Range("Q4"), xlAscending 'tri des colonnes          selon date colonne E = Charge F
   
   
    'Supprimer erreur ou "t" sur les centres de charge "B à F"
    For col = 4 To 16 Step 3 '4=colonne D --> 16=colonne P
        x = .Cells(3, col)
        For I = 4 To x + 4
            If IsError(.Cells(I, col + 1)) Then .Cells(I, col).Resize(1, 3).ClearContents 'efface les erreurs
            If UCase(.Cells(I, col + 1)) = "T" Then .Cells(I, col).Resize(1, 3).ClearContents 'efface les t et T
        Next I
    Next col
End With

'************************************************************************************************************************************************
'Trier les Charges
For I = 1 To 16 Step 3 '1 = Colonne A -->16 = Colonne P
    Fin = Cells(4, I).End(xlDown).Row - 3
    Cells(4, I).Resize(Fin, 3).Select
    ActiveWorkbook.Worksheets("Graph").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Graph").Sort.SortFields.Add Key:=Cells(4, I + 1), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Graph").Sort
        .SetRange Cells(4, I).Resize(Fin, 3) 'Range("A4:C1048576") ---->Pourquoi 1048576 ?
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Next I
   
Sheets("Charge 471").Calculate
Sheets("Graph").Calculate
Sheets("Graph2").Calculate

Sheets("Charge 471").Select 'inutile si on y est déjà.. commme en début de macro
End Sub

vgendron · 29 Avril 2017

Re Re 🙂
Voir PJ
les trois fonctions d'actualisations sont simplifiées
et vu qu'elles font la meme chose.. on pourrait surement n'en faire qu'une...

Lone-wolf · 29 Avril 2017

Bonjour vgendron 🙂

vgendron · 29 Avril 2017

Hello LoneWolf :-D

mapomme · 29 Avril 2017

Bonsoir à tous,

Une petite simplification d'écriture comme les formules sont identiques:
On doit pouvoir remplacer:

VB:

    .Range("A3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])" 'on colle en A3 la formule =nbval(B3:B37) pourquoi 37 ?
    .Range("D3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
    .Range("G3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
    .Range("J3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
    .Range("M3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
    .Range("P3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"

par:

VB:

.Range("A3,D3,G3,J3,M3,P3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"

mapomme · 29 Avril 2017

Re,

de même, on devrait pouvoir remplacer :

VB:

    'tri des charges
    .Range("A4:C" & derlig).Sort .Range("B4"), xlAscending 'tri des colonnes A B et C selon date colonne B = Charge H
    .Range("D4:F" & derlig).Sort .Range("E4"), xlAscending 'tri des colonnes D E et F selon date colonne   = Charge I
    .Range("G4:I" & derlig).Sort .Range("H4"), xlAscending 'tri des colonnes          selon date colonne   = Charge J
    .Range("J4:L" & derlig).Sort .Range("K4"), xlAscending 'tri des colonnes          selon date colonne   = Charge K
    .Range("M4:O" & derlig).Sort .Range("N4"), xlAscending 'tri des colonnes          selon date colonne   = Charge L
    .Range("P4:R" & derlig).Sort .Range("Q4"), xlAscending 'tri des colonnes          selon date colonne   = Charge M
    .Range("S4:U" & derlig).Sort .Range("T4"), xlAscending 'tri des colonnes          selon date colonne   = Charge N

par :

VB:

    For Each elem In Split("a d g j m p s")
      .Range(.Cells(4, elem), .Cells(derlig, elem)).Resize(, 3).Sort .Cells(4, elem).Offset(, 1), xlAscending
    Next elem

Lone-wolf · 29 Avril 2017

Bonsoir mapomme 🙂

Bien vu! 😉 . Mais vu qu'à la longue le tableau va s'agrandir, ce ne serait pas mieux une boucle For i = 4 To derlig, ou (si c'est possible) un tableau?

Danybrett · 29 Avril 2017

Bonjour mapomme, vgendron et merci à vous ainsi que Lone-wolf pour vos réponses 🙂
Je suis vraiment désolé aux vues du nombre de commentaire qui permettent une grande compréhension de votre code, je me rends bien compte que j'aurais dû en mettre, cela aurait été beaucoup plus simple

Donc je vais vous expliquer les points sur lesquels vous vous posez une question et je retourne la maquette excel avec vos superbes modification et 1 tonne de commentaires ajouté 🙂

ThisWorkbook.Save
' Je l'ai mis au début de chaque action car Excel avait tendance a crash à chaque fois que je lançais une macro

f=Cells(no_ligne,2)
' C'est pour récupérer aussi le nom sélectionner mais ta façon est beaucoup plus simple 😛

Sheets("Graph").Select
' En fait la macro actualisation est lancée depuis "charge 471" je me suis donc dit qu'il fallait tout d'abord sélectionner la feuille sur laquelle on voulait travailler.

.Range("A3").FormulaR1C1 = "=COUNTA(RC[1]:R[34]C[1])"
' En fait je me rends compte que "37" est une erreur de ma part dans une version précédente j'avais mis 999 9999 pour qu'il descende jusqu'en bas

If UCase(.Range("E" & I)) = "T" Then .Range("D4:F7").ClearContents
' L'opérateur dans la feuille "planning" a l'endroit où la date ce calcul vient entrer un "t" ou un "T" quand cette opération est finie ("t" pour terminer) et comme pour le calcul ce "t" engendre un #valeur et que comme un produit une fois fini entièrement et que l' l'opérateur le décide il peut simplement supprimer les 3 lignes de ce produit et donc dans graph, graph3, graph5 ça va engendre des #Ref c'est pour cela que j'ai besoin aussi de supprimer les erreurs

Sheets("Charge 471")
' Comme au début on été sur "Charge 471" et qu'on est allé sur "charge" pour faire les calculs je voulais retourner sur "Charge471" pour ne pas qu'on est à le re sélectionner.

Normalement si vous voulez voir ce que fait la macro vous pouvez enlever la commande qui passe excel en "actualisation manuelle" et la commande qui empêche le "rafraîchissement de l’écran" comme cela si vous n'avez pas un PC surpuissant la maquette devrait être beaucoup plus lente et vous laisser le temps de voir ce qu'elle fait en détail 🙂

désespérée que mes commentaires dans la macro sont clair et suffisant, j'ai fait de mon mieux pour expliquer 🙂

Danybrett · 29 Avril 2017

Oups je viens de me relire et j'avais pas fait attention avec la correction automatique sur la dernière ligne, c'est:
"J’espère que mes commentaires....." et non "désespérée que mes commentaires...." 😳

vgendron · 29 Avril 2017

Question pour Danybrett
Comment remplis tu les feuilles "Graph, Graph2 3 4 5 et 6 " à partir du planning?

vgendron · 30 Avril 2017

Voici ci jointe la révision 15 largement simplifiée..
pour la suite.. il faut que tu nous expliques le principe de remplissage des feuilles graphes à partir du planning
si ca se trouve.. une seule formule suffirait..

Voir tous les commentaires que j'ai mis dans les macros

Amélioration macro

Danybrett

XLDnaute Junior

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

Danybrett

XLDnaute Junior

Pièces jointes

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

Danybrett

XLDnaute Junior

Pièces jointes

Danybrett

XLDnaute Junior

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Amélioration macro

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency