Amélioration macro

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Danybrett
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
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é 😛) 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. 🙂
 

Pièces jointes

Trier par date Trier par votes
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
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.
 

Pièces jointes

Vote positif 0 Vote négatif
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
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
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
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
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 🙂
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Question Question
Microsoft 365 Macro pour recherche de cellules entre 2 fichiers Excel
Réponses
6
Affichages
62
wDog66
wDog66
O
  • Résolu(e)
Microsoft 365 Amélioration/réparation d'une Macro et création d'un bouton pour calcul consommation
2
Réponses
27
Affichages
736
Olihoes
O
P
  • Question Question
XL 2019 Macro VBA appliquer un filtre lors d'une importation de données
Réponses
1
Affichages
70
fanch55
fanch55
G
  • Résolu(e)
XL 2019 macro pour masquer puis afficher colonnes a la demande
Réponses
4
Affichages
160
Phil69970
Phil69970
Calvus
  • Question Question
Microsoft 365 Recherche incomplète planning (problème de dates)
Réponses
13
Affichages
248
p56
p56
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
123
JJ69
J
S
  • Résolu(e)
XL 2010 Bloquer les plages d'un graphique par rapport à un tableau
Réponses
8
Affichages
450
Sylvain89
S
D
  • Question Question
XL 2021 excel - vbs - csv
2
Réponses
28
Affichages
1 K
Deleted member 441486
D
T
  • Question Question
XL 2019 Mois en vba
2
Réponses
25
Affichages
1 K
AtTheOne
AtTheOne
patricktoulon
  • Question Question
Autres la fonction similaire
Réponses
11
Affichages
483
patricktoulon
patricktoulon
T
  • Résolu(e)
Microsoft 365 Problèmes liaisons fausses
Réponses
4
Affichages
620
Thomi
T
S
  • Résolu(e)
Microsoft 365 - Conseils pour la structuration d'une base de données -
2 3
Réponses
44
Affichages
3 K
crocrocro
C
K
  • Résolu(e)
XL 2013 Modifier noms de plage par lots
Réponses
6
Affichages
492
Kostrovit
K
L
  • Question Question
XL 2013 Liaisons Word / Excel : quelle solution retenir et comment la mettre en œuvre
2 3 4
Réponses
50
Affichages
4 K
LMOAL
L
J
  • Résolu(e)
Microsoft 365 macro effacement sélection cellules
2 3 4
Réponses
55
Affichages
4 K
Phil69970
Phil69970
C
  • Résolu(e)
Microsoft 365 Mise en forme d'une ligne d'après listes déroulantes + clic sur un bouton
Réponses
2
Affichages
580
casualexcel
C
S
  • Question Question
XL 2016 Problème de classement de prix croissants non désiré
Réponses
4
Affichages
654
chris
chris
S
  • Question Question
Autres Macro sous conditions
Réponses
3
Affichages
481
scorpileo
S
Sarmat31
  • Question Question
XL 2019 Mise en forme conditionnelle
Réponses
8
Affichages
756
TooFatBoy
TooFatBoy
P
  • Question Question
Microsoft 365 Automatisation entre classeurs
Réponses
1
Affichages
480
Gégé-45550
Gégé-45550
Retour