Amélioration macro

D

Danybrett

XLDnaute Junior
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é :p) 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 :p.

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 :p).

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. :)
 

Pièces jointes

  • Exemple tableau suiviV12.xlsm
    248.1 KB · Affichages: 52
Trier par date Trier par votes
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
D

Danybrett

XLDnaute Junior
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 :p

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.
 

Pièces jointes

  • Exemple tableau suiviV12.xlsm
    248.4 KB · Affichages: 37
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
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])"
 
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
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
 
Vote positif 0 Vote négatif
D

Danybrett

XLDnaute Junior
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 :p

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 :)
 

Pièces jointes

  • Exemple tableau suiviV12.xlsm
    246.5 KB · Affichages: 29
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
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
 

Pièces jointes

  • Exemple tableau suivi Rev15.xlsm
    301.7 KB · Affichages: 49
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
XL 2019 amélioration d'une macro (actualisation auto et automatisation)
Réponses
11
Affichages
310
rh.finances
R
G
  • Question
Microsoft 365 Macro VBA - Excel
Réponses
12
Affichages
247
Dranreb
Dranreb
S
  • Résolu(e)
XL 2010 Bloquer les plages d'un graphique par rapport à un tableau
Réponses
8
Affichages
269
Sylvain89
S
C
  • Résolu(e)
Microsoft 365 Amélioration Macro.
Réponses
7
Affichages
328
crazy
C
S
  • Question
Autres Ajouts de TAG automatique en fonction de l'année
Réponses
4
Affichages
244
Phil69970
Phil69970
T
  • Question
XL 2021 amélioration ludique VBA
Réponses
9
Affichages
630
thibaut1306
T
S
  • Question
Microsoft 365 Pulbipostage Excel→Word : cases à cocher
Réponses
1
Affichages
122
Staple1600
Staple1600
P
  • Question
Microsoft 365 Créer un tableau à partir de données entre deux dates
Réponses
6
Affichages
268
Pat-Sib
P
C
  • Résolu(e)
XL 2013 rajouter macro - fond jaune dans cellule
Réponses
2
Affichages
496
candido57
C
K
  • Question
Autres 'Resolu' 'Nettoyer' des lignes par une macro
Réponses
7
Affichages
240
klorane
K

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 43 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote