Optimisation de code VBA

[Astrolab]

Bonjour,

j'ai un fichier qui me sert à réaliser des calculs.

Pour ce faire j'ai en premier lieu une feuille "base de données" qui contient un tableau (mode tableau) du même nom.

Je rentre l'ensemble de mes données (lignes les unes en dessous des autres) ce qui a pour effet de redimensionner mon tableau.

Ensuite je lance une macro afin que les autres tableaux (dans des feuilles différentes) se mettent à jour du même nombre de lignes avec tout ou partie des renseignements contenus dans les lignes.

Les calculs peuvent alors s'opérer.

Tout fonctionne correctement en injectant plus de 100 000 lignes mais:
- le temps de traitement est long
- parfois impossible de réouvrir le fichier si on le ferme (config : win7pro 64 et excel 2016 64 , 16 go ram et un i5)

cela me contraint à faire des copier coller valeur sur une autre feuille.

Par ailleurs je désactive aussi le calcul automatique du classeur que je ne lance en manuel qu'après mais ça n'a pas beaucoup d'effet.

Ma demande:

je souhaiterai savoir si la durée du traitement est lié à "l'architecture" de la macro et comme je ne suis pas spécialiste bien qu'elle fonctionne, peut-être qu'une optimisation est possible ?

je vous joins le code pour avoir vos avis, merci

Private Sub BoutonMàJDonnées_Click()

    Application.ScreenUpdating = False

    Dim NbLignes As Long
    'Entrée manuelle du nouveau nombre de lignes que doit posséder l'onglet "Base de données"
    NbLignes = Application.InputBox(prompt:="Entrez le nombre de N.", Type:=1)
   
        If NbLignes > 0 Then
            NbLignes = NbLignes + 3
            'Mise à jour du nombre de lignes du tableau de l'onglet "Base de données"
            Sheets("Base de données").Select
            ActiveSheet.ListObjects("TableauBASEDEDONNEES").Resize Range(Cells(3, 1), Cells(NbLignes, 26))
   
            'Mise à jour du nombre de lignes du tableau de l'onglet "M_Seg"
            Sheets("M_Seg").Select
            ActiveSheet.ListObjects("TableauMSEG").Resize Range(Cells(3, 1), Cells(NbLignes, 15))
  
            'Mise à jour du nombre de lignes du tableau de l'onglet "M_Pré"
            Sheets("M_Pré").Select
            ActiveSheet.ListObjects("TableauMPRE").Resize Range(Cells(3, 1), Cells(NbLignes, 34))
  
            'Mise à jour du nombre de lignes du tableau de l'onglet "M_Séc"
            Sheets("M_Séc").Select
            ActiveSheet.ListObjects("TableauMSEC").Resize Range(Cells(3, 1), Cells(NbLignes, 14))

            'Mise à jour du nombre de lignes du tableau de l'onglet "M_Pla"
            Sheets("M_Pla").Select
            ActiveSheet.ListObjects("TableauMPLA").Resize Range(Cells(3, 1), Cells(NbLignes, 65))

 

[Lone-wolf]

Bonjour Astrolab et bienvenue sur XLD

Enlève tous les select pour commencer et tu met Sheets("Base de données").ListObjects(xxxx) , ceci pour toutes les feuilles.
Pour le reste, il faut passer peut-être par des tableaux (for i = LBound(tablo) To Ubound(tablo)) plus ou moins come ceci, mais moi je ne suis pas assez fortiche pour celà.

 

[job75]

Bonjour Astrolab, bienvenue sur XLD, salut Lone-wolf,

La structure de la macro n'est pour rien dans votre problème, simplement les Select sont tout à fait inutiles :

Private Sub BoutonMàJDonnées_Click()
    Dim NbLignes As Long
    'Entrée manuelle du nouveau nombre de lignes que doit posséder l'onglet "Base de données"
    NbLignes = Application.InputBox(prompt:="Entrez le nombre de N.", Type:=1)
    If NbLignes < 1 Then Exit Sub
    NbLignes = NbLignes + 3
    Sheets("Base de données").ListObjects("TableauBASEDEDONNEES").Resize Range(Cells(3, 1), Cells(NbLignes, 26))
    Sheets("M_Seg").ListObjects("TableauMSEG").Resize Range(Cells(3, 1), Cells(NbLignes, 15))
    Sheets("M_Pré").ListObjects("TableauMPRE").Resize Range(Cells(3, 1), Cells(NbLignes, 34))
    Sheets("M_Séc").ListObjects("TableauMSEC").Resize Range(Cells(3, 1), Cells(NbLignes, 14))
    Sheets("M_Pla").ListObjects("TableauMPLA").Resize Range(Cells(3, 1), Cells(NbLignes, 65))
End Sub

Les formules qui se trouvent dans les tableaux prennent sans doute trop de temps de calcul.

Il faudrait joindre le fichier (allégé), quelques lignes suffisent dans chaque feuille.

A+

 

[Astrolab]

Bonjour,

merci pour vos réponses. Effectivement fonctionne très bien sans les selects.

A y réfléchir vous avez surement raison, les formules sont nombreuses...ceci explique cela.

Joindre un fichier allégé est compliqué pour l'instant mais vos réponses permettent de m'orienter et c'est déjà beaucoup.

@+

 

[Lone-wolf]

Bonjour job75

En utilisant le DAO ou ADO je sais plus, et copier les tableaux à la suite (end(xlup)(2)) , avec les formules ça changerait quelque chose?