XL 2016 VBA - Diminution temps d'exécution

[Remteyss]

Bonjour le forum,

Encore besoin de votre aide... Ayant réalisé un script qui fonctionne relativement bien, on me demande à présent de chercher à diminuer au mieux le temps d'exécution.
Pour cela, j'ai notamment forcé les configurations suivantes :

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
newFSM.DisplayPageBreaks = False

Puis, je les rétabli à la fin de mon code. Sur les 1min50 que mettait environ mon code, il en met à présent 1min25, ce qui est déja pas mal vous me direz !
Mais la taille de ma feuille Excel risquant de s'agrandir, je voudrais optimiser au maximum ce temps d'exécution.
J'ai notamment lu que lire directement ma plage de données avant ma boucle for permettait de ne pas la lire x fois !
Pour cela, j'ai donc changé mes range utilisant la fonction Find de la sorte :

Set celluletrouvee = mafeuille.Find(....)
devient alors
celluletrouvee = mafeuille.Find(...).Value (celluletrouvee étant à présent défini comme un variant)

Cependant, lorsque je trouve la bonne cellule, je récupère la ligne et la colonne comme suit :
ligtrouv = celluletrouvee.Row
coltrouv = celluletrouvee.Column

Bien entendu, cela fonctionnait avec ma variable définie comme Range mais comment faire pour récupérer les valeurs de ligne et colonne d'un variant ?
Je suis encore débutant en VBA donc peut-être que la solution est simple mais que je ne la vois pas !

En vous remerciant,
Remteyss

 

[TooFatBoy]

Bonjour,

Il est très souvent conseillé ici d'utiliser un tableau (mettre le contenu des cellules à traiter dans une variable, tableau à deux dimensions) plutôt que de travailler directement sur les données de la feuille, pour aller beaucoup plus vite.

 

[Remteyss]

Bonjour,

Merci pour votre retour. Dans ce cas, il faut par exemple que je définisse dans un premier temps mes range (j'utilise 3 feuilles excel).
Puis que je rentre chacun de ces range dans un variant v_i (i= 1,2,3) par exemple ?
Pour utiliser ensuite la fonction Find, a-t-on le droit de mettre le tableau v en paramètre à la place du range ?


Bonne soirée

 

[TooFatBoy]

D'après ce que j'ai pu lire ici (as-tu fait une recherche sur le forum ?), je pensais plus à quelque chose comme ça :

Sub test()
Dim DonneesFeuil1() As Variant

    ' Écrire les données de la feuille dans une variable tableau
    DonneesFeuil1() = Sheets("Feuil1").Range("A1:J5").Value

    ' Écrire une donnée de la variable tableau dans une feuille
    Sheets("Feuil2").Range("A12").Value = DonneesFeuil1(5, 2)

    ' Écrire toutes les données de la variable tableau dans une feuille
    Sheets("Feuil2").Range("B2:K65").Value = DonneesFeuil1()

End Sub

Une fois que tes données sont dans la variable tableau, ça devrait aller beaucoup plus vite au niveau du traitement de ces données.

Mais ce n'est qu'une piste. Je ne saurais guère t'en dire plus...

 

[Remteyss]

Ok je vois ton idée je vais essayer, merci !
En effet, je vais aussi jeter un oeil aux sujets déja présents sur le forum.

 

[jmfmarques]

Bonjour

je vais aussi jeter un oeil aux sujets déja présents sur le forum.

et comment (qu'as-tu prévu à cet effet) comptes-tu ensuite le récupérer, cet oeil-là ??? Prudence, ami, avant de jeter quoi que ce soit à qui/quoi que ce soit...

 

[Staple1600]

Bonsoir le fil, Remteyss, Marcel32, jmfmarques

Bonjour le forum,
Ayant réalisé un script qui fonctionne relativement bien, on me demande à présent de chercher à diminuer au mieux le temps d'exécution.
Je suis encore débutant en VBA donc peut-être que la solution est simple mais que je ne la vois pas !

Si on pouvait lire ton script (ici dans cette discussion), tu pourrais voir rapidement non pas une solution mais moult.

 

[Remteyss]

Bonjour,

En effet, cela sera plus simple pour tout le monde si je joins le code. Le voici ci-dessous.
En quelques mots, ce code consiste à :
- récupérer chaque nom d'objet du classeur appelé OBD MAP
- chercher ce nom dans la oldFSM et copier sur cette ligne chaque cellule pour laquelle le nom de la colonne est identique à celui de la newFSM
- coller ces cellules sur la première ligne vide de la newFSM

Je ne peux malheureusement pas vous joindre les classeurs correspondants, ils sont soumis à une certaine confidentialité.

Merci à ceux qui auront le courage de tout lire !

Option Explicit


Public ChemoldFSM
Public ChemOBDMAP
Public ChemnewFSM
Public NomnewFSM
Public NomoldFSM
Public NomOBDMAP
Public oldFSM As Workbook
Public newFSM As Workbook
Public OBDMAP As Workbook

Sub CB_Start_Click()
    Dim soldFSM As Worksheet
    Dim snewFSM As Worksheet
    Dim sOBDMAP As Worksheet
    Dim BoEcran As Boolean, BoAlert As Boolean, BoBarre As Boolean, BoEvent As Boolean, BoSaut As Boolean
    Dim iCalcul As Integer
    Dim objet As String
    Dim colonne As String
    Dim valeur As String
    Dim i As Integer
    Dim j As Integer
    Dim alreadyfound As Range
    Dim celluletrouvee As Range
    Dim colonnetrouvee As Range
    Dim ligtrouv As Integer
    Dim lig As Integer
    Dim coltrouv As Integer
    Dim col As Integer
    Dim DernLigne As Integer
    Dim DernCol As Integer
    Dim l As Integer
    Dim k As Integer
    Dim m As Integer
    Dim A As Integer
    Dim debut As Date, temps As Date, fin As Date
    
    debut = Time
    
    Set soldFSM = Workbooks(NomoldFSM).Worksheets(3)
    Set snewFSM = Workbooks(NomnewFSM).Worksheets(3)
    Set sOBDMAP = Workbooks(NomOBDMAP).Worksheets(3)
        
        
    '   Conservation des configurations existantes :
    BoEcran = Application.ScreenUpdating
    BoAlert = Application.DisplayAlerts
    BoBarre = Application.DisplayStatusBar
    iCalcul = Application.Calculation
    BoEvent = Application.EnableEvents
    BoSaut = snewFSM.DisplayPageBreaks

    ' On force les configurations :

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    snewFSM.DisplayPageBreaks = False

    i = sOBDMAP.Columns(3).Find("", , , , xlByColumns, xlNext).Row - 1 'Nb lignes début OBD MAP jusqu'à fin tableau
    j = sOBDMAP.Cells(6, Cells.Columns.Count).End(xlToLeft).Column + 1 'Nb colonnes début OBD MAP jusqu'à fin tableau

    DernLigne = snewFSM.Range("C" & Rows.Count).End(xlUp).Row
    DernCol = snewFSM.Cells(2, Cells.Columns.Count).End(xlToLeft).Column 'Numéro dernière colonne FSM Geely
    A = DernLigne + 1
'    MsgBox "derniere ligne : " & DernLigne & " et A = " & A
    


'    MsgBox "Tableau de " & i & " lignes et " & j & " colonnes."

    For k = 6 To i 'Parcourir les lignes du tableau de l'OBD MAP


        For l = 5 To j 'Parcourir les colonnes du tableau de l'OBD MAP
            objet = sOBDMAP.Cells(k, l).Value 'nom de l'objet
'            MsgBox "On cherche " & objet = sOBDMAP.Cells(k, l).Value

            If Not IsError(Application.Match(monitor, snewFSM.Range("H3:H400"), 0)) Then
'                MsgBox objet & " déjà présent et copié."
                
            Else
'                MsgBox objet & " à copier."
    
    
                If Len(monitor) = 2 Then
                    Set celluletrouvee = soldFSM.Range("H3:H370").Find(objet, LookIn:=xlValues, LookAt:=xlWhole)
                Else
                    Set celluletrouvee = soldFSM.Range("H3:H370").Find(objet, LookIn:=xlValues, LookAt:=xlPart) 'recherche du moniteur dans la FSM du projet BMW/Magna
                End If
    
                If celluletrouvee Is Nothing Then
    '               MsgBox objet & " non trouvé à la ligne " & k & ", colonne " & l & "."
    
                Else
                    ligtrouv = celluletrouvee.Row 'ligne de l'objet dans l'ancien projeet
                    coltrouv = celluletrouvee.Column 'colonne de l'objet dans l'ancien projet
    
    '                MsgBox "Cellule trouvée, correspondant à " & monitor & " dans l'OBDMAP (ligne " & k & ", colonne " & l & ")."
    
                        For i = 1 To DernCol
                            colonne = snewFSM.Cells(2, i).Value 'nom de la colonne i dans la nouvelle FSM
    
                            Set colonnetrouvee = soldFSM.Range("2:2").Find(colonne, LookIn:=xlValues) 'recherche de la colonne i dans l'ancienne FSM
    
                            If Not colonnetrouvee Is Nothing Then
    
                                lig = colonnetrouvee.Row
                                col = colonnetrouvee.Column
    
    '                            MsgBox "Nom de colonne trouvé à la ligne " & lig & " et à la colonne " & col & "."
                                soldFSM.Cells(ligtrouv, col).Copy _
                                    Destination:=snewFSM.Cells(A, i)
    
                            Else
    
    '                        MsgBox "Nom de colonne pas trouvé, colonne à laisser vide."
    
                            End If
    
                        Next
                    A = A + 1
    '                       MsgBox objet & "trouvé à la ligne " & ligne & " à la colonne = " & col
                End If
 
            End If
        Next

    Next

    '   Restauration des configurations :
    
    Application.ScreenUpdating = BoEcran
    Application.DisplayAlerts = BoAlert
    Application.DisplayStatusBar = BoBarre
    Application.Calculation = iCalcul
    Application.EnableEvents = BoEvent
    snewFSM.DisplayPageBreaks = BoSaut

    fin = Time
    temps = fin - debut
    MsgBox "Remplissage terminée." & Chr(10) & "Temps d'exécution : " & temps

End Sub

 

[Staple1600]

Re,

Après une lecture rapide et si j'ai bien compris ce que doit faire ce code, j'utiliserai plutôt le filtré avance en VBA avec l'option Copier vers
(cela devrait être plus rapide)

 

[Remteyss]

Re,

Après une lecture rapide et si j'ai bien compris ce que doit faire ce code, j'utiliserai plutôt le filtré avance en VBA avec l'option Copier vers
(cela devrait être plus rapide)

Bonjour,

Etant encore débutant en VBA, si j'utilise la fonction "Copier vers un autre emplacement" du filtre avancé ; je devrais sélectionner une plage de cellules fixe non ? Car mon script doit fonctionner pour différents fichiers sources.

 

[Staple1600]

Re

•>Remteyss
Un fichier exemple allégé et anonymisé et reproduisant la structure de l'original serait utile pour savoir si le filtre élaboré est une piste à suivre ou pas.
En guise de test, on fera la copie sur autre feuille
(Il suffira d'adapter pour la faire sur la feuille d'un autre classeur)

 

[Remteyss]

Re

•>Remteyss
Un fichier exemple allégé et anonymisé et reproduisant la structure de l'original serait utile pour savoir si le filtre élaboré est une piste à suivre ou pas.
En guise de test, on fera la copie sur autre feuille
(Il suffira d'adapter pour la faire sur la feuille d'un autre classeur)

Bonjour,

Ci-joint mes trois fichiers représentant la structure de mes fichiers originaux. J'ai bien entendu laissés de nombreuses cellules vides mais j'ai tout de même représenté la même organisation concernant le titre des colonnes du fichier base de données et du fichier cible.
Voici les correspondances par rapport à mon code :
Feuille base de données = soldFSM
Feuille Fichier cible = snewFSM
Feuille Fichier source = sOBDMAP

Merci à vous

 

[Staple1600]

Bonjour le fil, Remteyss

Tu parles de code VBA mais tu joins des *.xlsx (qui ne peuvent pas contenir de macros)
Dans quel classeur devra se trouver le code VBA?

 

[Remteyss]

Bonjour le fil, Remteyss

Tu parles de code VBA mais tu joins des *.xlsx (qui ne peuvent pas contenir de macros)
Dans quel classeur devra se trouver le code VBA?

En effet, le code que je vous ai envoyé précédemment est contenu dans un 4è fichier .xlsm.

 

[Staple1600]

Re

En effet, le code que je vous ai envoyé précédemment est contenu dans un 4è fichier .xlsm.

Et c'est donc logiquement qu'on ne trouve que trois fichiers joints dans le message#13...