Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 VBA - Optimisation Code Array

Spinzi

XLDnaute Impliqué
Bonjour à tous,

Je me suis lancé dans une programmation VBA suite à une demande urgente.

Maintenant que tout est opérationnel, j'aimerai pouvoir optimiser ce code pour qu'il tourne plus rapidement. A titre d'exemple, le fichier complet met environ 3 minutes pour sortir 10 grilles d'évaluation (sur 160 répondant aux critères de génération).

Vous trouverez en PJ une version allégée avec seulement le cœur du programme :
_l'onglet "Bilan CL" qui permet, suivant certains critères, de lancer la macro (si critère 1,2 et 3 validés - colonne K = vrai - et pas déjà généré alors - colonne L)
_le programme colle simplement le numéro de CL dans l'onglet "Synthèse" qui va alimenter les onglets "Critères N°"
Ces onglets sont alimentés via des formules et tapent dans des bases de données variant de 1 à 10 000 lignes. Utilisant avant des formules matricielles (qui alourdissent le traitement), le forum m'a permis de créer le module "Extraction" pour remplacer mes formules matricielles par des formules personnalisées, améliorant déjà les performances.
_le programme va ensuite copier les onglets "Synthèse" => "Extraction Eval" dans un nouveau classeur, renommé suivant le numéro, nom et date d'exécution de la macro.

Voyant les bénéfices apportés par le passage au format tableau (au sens Array), je me demande si il est possible de modifier mes variables dans le module "Generation Grille" pour améliorer le code.

Evidemment si vous voyez d'autres améliorations possibles, n'hésitez pas ! (le but étant tout de même de garder une simplicité dans la compréhension du programme, n'étant que débutant en VBA).

A vous relire si je ne suis pas clair dans ma demande,

Merci d'avance pour votre aide précieuse.

Spinzi
 

Pièces jointes

  • Outil de Génération des Grilles d'Evaluation Test.xlsm
    173.3 KB · Affichages: 28
Trier par date Trier par votes

Spinzi

XLDnaute Impliqué
Et voici le code :
Code: 
Option Explicit
Sub OGGE()
'-----------------------------------'
'   Dimensionnement des variables   '
'-----------------------------------'
'Variables pour programme
'------------------------
    'Variables de l'onglet Bilan CL
Dim LIG_CL As Integer
Dim Num_CL As String
Dim NOM_CL As String
Dim NOMREG_CL As String
Dim CRIT_CL As String
Dim GEN_CL As String
    'Variables pour g?n?ration dans r?pertoires par r?gion
Dim CHEM_DOSSIER As String
Dim NOM_SDOSSIER As String
Dim NOM_COMPLET As String
    'Variables pour suppression des formules dans grilles
Dim NOM_FICH As String
Dim CHEM_FICH As String
    'Variable pour identification des grilles en doublon
Dim FICH_DOUBLON As String 'Comptage des doublons
    'D?finition des variables
LIG_CL = 8                                                      'On commence ? la ligne 8 de l'onglet Bilan
NOM_FICH = ThisWorkbook.Name
Num_CL = Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 1)         'Colonne 1
NOM_CL = Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 4)
NOMREG_CL = Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 6)
CRIT_CL = Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 11)
GEN_CL = Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 12)
CHEM_DOSSIER = "C:\Users\quentin.schultz\Documents\Documents\Documents Quentin\Documents Excel\2019_Romain L.- Crit?res CL\02. Tests 8\"
NOM_SDOSSIER = "Grilles Eval"
CHEM_FICH = ThisWorkbook.Path
    'Modification des configurations pour am?lioration vitesse traitement
With Application
    .ScreenUpdating = 0
    .Calculation = xlCalculationManual
End With

'-----------------------------------'
'   Programme - Selection Dossier   '
'-----------------------------------'
    'Activation du pop up pour patienter
Traitement.Show 0

'/Initialisation du programme
'----------------------------
Do While Not Num_CL = ""        'tant qu'un num?ro de CL est rempli
    
    If CRIT_CL = "Faux" Or GEN_CL = "Oui" Then      'et que les crit?res sont remplis ("VRAI" et pas encore g?n?r?)
        GoTo FinBoucle
    
    Else: Workbooks(NOM_FICH).Sheets(2).Cells(4, 3) = Num_CL    'alors inscription du num?ro de CL dans la synth?se
    Calculate
    
    End If
    
'-----------------------------------------------------------'
'   Programme - Gestion des erreurs                         '
'-----------------------------------------------------------'
'D?finition des variables pour gestion des doublons
NOM_COMPLET = CHEM_DOSSIER & NOMREG_CL & "\" & NOM_SDOSSIER  'initialisation du nom complet de sauvegarde - doit faire partie de la boucle pour incr?mentation des variables
FICH_DOUBLON = Dir(NOM_COMPLET & "\" & Num_CL & "_" & NOM_CL & "_OGGE" & ".xlsx")    'utile pour v?rifier si le fichier existe d?j? ou pas

    If FICH_DOUBLON = "" Then     'si le fichier n'existe pas
    
        Sheets(Array(2, 3, 4, 5, 6)).Copy 'copie des onglets
        Sheets(1).Range("B1").CurrentRegion.Select
        Sheets(5).Visible = 0
    
    Else: GoTo FinBoucle    'sinon on va en fin de boucle
    End If

'-----------------------------------------------------------'
'   Programme - Sauvegarde                                  '
'-----------------------------------------------------------'
    
'Sauvegarde nouveau classeur
'---------------------------
    With ActiveWorkbook
        '.BreakLink Name:=CHEM_FICH & "\" & NOM_FICH, Type:=xlExcelLinks 'suppression des formules
        .SaveAs Filename:=NOM_COMPLET & "\" & Num_CL & "_" & NOM_CL & "_OGGE", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        .Close
    End With
    
'Application des donn?es de contr?le
'-----------------------------------
    Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 12) = "Oui"
    Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 13) = Num_CL & "_" & NOM_CL & "_Trait? par OGGE"
    Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 14) = Date
    Workbooks(NOM_FICH).Sheets(1).Cells(1, 11) = Date
    
    'Signet de la fin de boucle
FinBoucle:
    
    Workbooks(NOM_FICH).Sheets(1).Select                 'on revient sur le classeur d'origine
    
'Incr?mentation des variables
'----------------------------
    LIG_CL = LIG_CL + 1       'On incr?mente Lig
    CRIT_CL = Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 11)
    Num_CL = Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 1)
    NOM_CL = Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 4)
    NOMREG_CL = Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 6)
    GEN_CL = Workbooks(NOM_FICH).Sheets(1).Cells(LIG_CL, 12)
    
Loop        'et on boucle
    'Modification des configurations pour am?lioration vitesse traitement
With Application
    .ScreenUpdating = 1
    .Calculation = xlCalculationAutomatic
End With
    'Mise ? jour pop up
Unload Traitement
Termine.Show 0
End Sub

Spinzi
 
Vote positif 0 Vote négatif

ChTi160

XLDnaute Barbatruc
Bonjour Spinzi
Bonjour le Fil , le Forum
pas évident sans pouvoir tester .
VB: 
Sub OGGE()
'-----------------------------------'
'   Dimensionnement des variables   '
'-----------------------------------'
'Variables pour programme
'------------------------
    'Variables de l'onglet Bilan CL
Dim LIG_CL As Integer
Dim Num_CL As String
Dim NOM_CL As String
Dim NOMREG_CL As String
Dim CRIT_CL As String
Dim GEN_CL As String
    'Variables pour g?n?ration dans r?pertoires par r?gion
Dim CHEM_DOSSIER As String
Dim NOM_SDOSSIER As String
Dim NOM_COMPLET As String
    'Variables pour suppression des formules dans grilles
Dim NOM_FICH As String
Dim CHEM_FICH As String
    'Variable pour identification des grilles en doublon
Dim FICH_DOUBLON As String 'Comptage des doublons
    'D?finition des variables
With Application
    .ScreenUpdating = 0
    .Calculation = xlCalculationManual
End With
CHEM_DOSIER = "C:\Users\quentin.schultz\Documents\Documents\Documents Quentin\Documents Excel\2019_Romain L.- Crit?res CL\02. Tests 8\"
NOM_SDOSSIER = "Grilles Eval"
   CHEM_FICH = ThisWorkbook.Path
   LIG_CL = 8                                                      'On commence ? la ligne 8 de l'onglet Bilan
NOM_FICH = ThisWorkbook.Name
With Workbooks(NOM_FICH)
With .Sheets(1)
   Num_CL = .Cells(LIG_CL, 1)         'Colonne 1
   NOM_CL = .Cells(LIG_CL, 4)
NOMREG_CL = .Cells(LIG_CL, 6)
  CRIT_CL = .Cells(LIG_CL, 11)
   GEN_CL = .Cells(LIG_CL, 12)
End With
'Modification des configurations pour amélioration vitesse traitement
'-----------------------------------'
'   Programme - Selection Dossier   '
'-----------------------------------'
    'Activation du pop up pour patienter
Traitement.Show 0
'/Initialisation du programme
'----------------------------
Do While Not Num_CL = ""        'tant qu'un num?ro de CL est rempli   
    If CRIT_CL = "Faux" Or GEN_CL = "Oui" Then      'et que les critéres sont remplis ("VRAI" et pas encore g?n?r?)
        GoTo FinBoucle   
    Else: .Sheets(2).Cells(4, 3) = Num_CL    'alors inscription du numéro de CL dans la synth?se
    Calculate   
    End If
End With
'-----------------------------------------------------------'
'   Programme - Gestion des erreurs                         '
'-----------------------------------------------------------'
'D?finition des variables pour gestion des doublons
NOM_COMPLET = CHEM_DOSSIER & NOMREG_CL & "\" & NOM_SDOSSIER  'initialisation du nom complet de sauvegarde - doit faire partie de la boucle pour incrémentation des variables
FICH_DOUBLON = Dir(NOM_COMPLET & "\" & Num_CL & "_" & NOM_CL & "_OGGE" & ".xlsx")    'utile pour vérifier si le fichier existe déjà ou pas
    If FICH_DOUBLON = "" Then     'si le fichier n'existe pas   
        Sheets(Array(2, 3, 4, 5, 6)).Copy 'copie des onglets
        Sheets(1).Range("B1").CurrentRegion.Select
        Sheets(5).Visible = 0   
    Else: GoTo FinBoucle    'sinon on va en fin de boucle
    End If
'-----------------------------------------------------------'
'   Programme - Sauvegarde                                  '
'-----------------------------------------------------------'   
'Sauvegarde nouveau classeur
'---------------------------
    With ActiveWorkbook
        '.BreakLink Name:=CHEM_FICH & "\" & NOM_FICH, Type:=xlExcelLinks 'suppression des formules
        .SaveAs Filename:=NOM_COMPLET & "\" & Num_CL & "_" & NOM_CL & "_OGGE", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        .Close
    End With   
'Application des donn?es de contr?le
'-----------------------------------
    With Workbooks(NOM_FICH)
     With .Sheets(1)
          .Cells(LIG_CL, 12) = "Oui"
          .Cells(LIG_CL, 13) = Num_CL & "_" & NOM_CL & "_Trait? par OGGE"
          .Cells(LIG_CL, 14) = Date
          .Cells(1, 11) = Date
     End With
    End With
    'Signet de la fin de boucle
FinBoucle:   
    With Workbooks(NOM_FICH)
      With .Sheets(1) '.Select                 'on revient sur le classeur d'origine   
'Incrémentation des variables
'----------------------------
       LIG_CL = LIG_CL + 1       'On incr?mente Lig
      CRIT_CL = .Cells(LIG_CL, 11)
       Num_CL = .Cells(LIG_CL, 1)
       NOM_CL = .Cells(LIG_CL, 4)
    NOMREG_CL = .Cells(LIG_CL, 6)
       GEN_CL = .Cells(LIG_CL, 12)
      End With
    End With
Loop        'et on boucle
    'Modification des configurations pour am?lioration vitesse traitement
With Application
    .ScreenUpdating = 1
    .Calculation = xlCalculationAutomatic
End With
    'Mise ? jour pop up
Unload Traitement
Termine.Show 0
End Sub
Non testé .
Quelques modifications susceptibles d'améliorées le traitement
jean marie
 
Vote positif 0 Vote négatif

ChTi160

XLDnaute Barbatruc
Re
Ok
mais comme j'ai vu ceux ci , j'ai pas tenté Lol
CHEM_DOSIER = "C:\Users\quentin.schultz\Documents\Documents\Documents Quentin\Documents Excel\2019_Romain L.- Crit?res CL\02. Tests 8\"
Cliquez pour agrandir...
Effectivement ca bug lors de l'enregistrement... Toi tu testes et tu nous dis Lol
jean marie
 
Dernière édition:
Vote positif 0 Vote négatif

Spinzi

XLDnaute Impliqué
Re,

je n'ai pas constaté d'amélioration significative sur le temps de traitement.

Il y a un end with mal placé dans votre code, que j'ai replacé plus haut, c'est peut être ce qui ne va pas ?
VB: 
Sub OGGE()
'-----------------------------------'
'   Dimensionnement des variables   '
'-----------------------------------'
'Variables pour programme
'------------------------
'Variables de l'onglet Bilan CL
Dim LIG_CL As Integer
Dim Num_CL As String
Dim NOM_CL As String
Dim NOMREG_CL As String
Dim CRIT_CL As String
Dim GEN_CL As String
'Variables pour g?n?ration dans r?pertoires par r?gion
Dim CHEM_DOSSIER As String
Dim NOM_SDOSSIER As String
Dim NOM_COMPLET As String
'Variables pour suppression des formules dans grilles
Dim NOM_FICH As String
Dim CHEM_FICH As String
'Variable pour identification des grilles en doublon
Dim FICH_DOUBLON As String 'Comptage des doublons
'D?finition des variables
With Application
.ScreenUpdating = 0
.Calculation = xlCalculationManual
End With
CHEM_DOSIER = "C:\Users\quentin.schultz\Documents\Documents\Documents Quentin\Documents Excel\2019_Romain L.- Crit?res CL\02. Tests 8\"
NOM_SDOSSIER = "Grilles Eval"
CHEM_FICH = ThisWorkbook.Path
LIG_CL = 8                                                      'On commence ? la ligne 8 de l'onglet Bilan
NOM_FICH = ThisWorkbook.Name
With Workbooks(NOM_FICH)
With .Sheets(1)
Num_CL = .Cells(LIG_CL, 1)         'Colonne 1
NOM_CL = .Cells(LIG_CL, 4)
NOMREG_CL = .Cells(LIG_CL, 6)
CRIT_CL = .Cells(LIG_CL, 11)
GEN_CL = .Cells(LIG_CL, 12)
End With
End With 'replacé ici
'Modification des configurations pour amélioration vitesse traitement
'-----------------------------------'
'   Programme - Selection Dossier   '
'-----------------------------------'
'Activation du pop up pour patienter
Traitement.Show 0
'/Initialisation du programme
'----------------------------
Do While Not Num_CL = ""        'tant qu'un num?ro de CL est rempli 
If CRIT_CL = "Faux" Or GEN_CL = "Oui" Then      'et que les critéres sont remplis ("VRAI" et pas encore g?n?r?)
GoTo FinBoucle
Else: '.Sheets(2).Cells(4, 3) = Num_CL   Workbooks(NOM_FICH).Sheets(2)[LEFT][SIZE=4][FONT=Segoe UI][COLOR=rgb(20, 20, 20)].Cells(4, 3) = Num_CL 'et réintégré ici[/COLOR][/FONT][/SIZE][/LEFT]
Calculate
End If
'End With erreur ici
'-----------------------------------------------------------'
'   Programme - Gestion des erreurs                         '
'-----------------------------------------------------------'

Pensez vous que le passage en tableau sur la partie d'initialisation du programme puisse améliorer les choses ?

J'ai aussi mon USF qui se redimensionne tout seul à chaque loop j'ai l'impression, possible d'éviter cela ?

Merci en tous cas,
Spinzi
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

D
  • Résolu(e)
Microsoft 365 Filtre avancé VBA multi-critères
Réponses
14
Affichages
431
DELHOMME
D
  • Résolu(e)
XL 2013 RollOver sur cell sans boucle peut on modifier le lien avec une liste(array en VBA)
6 7 8
Réponses
114
Affichages
6 K
TooFatBoy
M
  • Question
Microsoft 365 Question code VBA
Réponses
2
Affichages
348
Maxou69
M
E
  • Résolu(e)
Microsoft 365 Conception d'un outils alliant faciliter d'utilisation et optimisation de la RAM/Processeur/Espace Disque
Réponses
6
Affichages
673
elgringo123456
E
A
  • Résolu(e)
XL 2019 Passage de 2013 pro à 2019 pro, Pb avec formule VBA, liens hypertexte
2 3 4
Réponses
54
Affichages
2 K
sylvanu
C
  • Résolu(e)
Microsoft 365 Amélioration de mon code VBA
Réponses
9
Affichages
581
Cherrylie
C
L
  • Résolu(e)
XL 2019 Déplacer ligne d'un tableau structuré à un autre, au choix [VBA]
Réponses
13
Affichages
921
Leguyl
L
K
  • Résolu(e)
Microsoft 365 Ajouter des onglets selon une cellule et une trame
Réponses
7
Affichages
853
Kstanisic
K
F
  • Question
Microsoft 365 Optimisation code VBA - Succession de copier coller
Réponses
8
Affichages
2 K
flomag
F
P
  • Question
XL 2016 Code VBA pour incrémentation automatique tableau
Réponses
6
Affichages
929
Paskal_35
P
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…