Microsoft 365 Reduire Temps Execution Code

[eric72]

Bonjour à tous,
Je profite de ce post pour vous souhaiter une belle année 2025
Je me tourne vers votre savoir afin de, peut-être, réduire le temps d'exécution d'une macro (macro sur un tableau qui peut atteindre 2000 lignes et 139 colonnes), en effet lorsque tout est rempli cela peut atteindre près de 30 secondes, mais il y a surement mieux à faire!!!
Voici le code:

Sub Copier_Valeurs()
Dim start As Single
start = Timer
Dim LigneSource As Long, LigneCible As Long
Dim MaValeur As String
Dim MaPlageDeRecherche As Range, MaCelluleTrouvee As Range

    ' On empêche la mise à jour de l'affichage
    Application.ScreenUpdating = False
    ' Pour chaque ligne de données du tableau source
    For LigneSource = 1 To Range("TbCommande").ListObject.ListRows.Count

        ' Affectation de la valeur à rechercher (colonne "Référence Devis", ligne de n° "LigneSource" du tableau source) à la variable MaValeur
        MaValeur = Range("TbCommande[Référence Devis]")(LigneSource).Value
        ' Affectation de toute la colonne de données "Référence Devis" du tableau source à la variable MaPlageDeRecherche
        Set MaPlageDeRecherche = Range("TbMAJ[Référence Devis]")
        ' Recherche de MaValeur dans la colonne "Référence Devis" du tableau cible
        ' Si la valeur est trouvée, affectation à la variable MaCelluleTrouvee de la cellule trouvée de la feuille
        ' si la valeur n'est pas trouvée, la variable MaCelluleTrouvee est égale à Nothing
        Set MaCelluleTrouvee = MaPlageDeRecherche.Find(What:=MaValeur, LookIn:=xlValues, LookAt:=xlWhole)

        If MaCelluleTrouvee Is Nothing Then
            ' Si valeur non trouvée dans le tableau cible, ajout d'une ligne en fin de tableau cible
            Range("TbMAJ").ListObject.ListRows.Add
            ' Détermination du n° de la nouvelle ligne du tableau cible
            LigneCible = Range("TbMAJ").ListObject.ListRows.Count
        Else
            ' Détermination du n° de ligne dans tableau, de la cellule trouvée
            LigneCible = MaCelluleTrouvee.Row - Range("TbMAJ[#headers]").Row
        End If

        ' Recopie du premier groupe de données vers le tableau cible
        Range("TbMAJ[[Référence Devis]:[Init]]").Rows(LigneCible).Value = Range("TbCommande[[Référence Devis]:[Init]]").Rows(LigneSource).Value
        'Range("TbMAJ[[Métrage OUI]:[Commande passée au Fournisseur]]").Rows(LigneCible).Value = Range("TbCommande[[Métrage OUI]:[Commande passée au Fournisseur]]").Rows(LigneSource).Value

        '[Commande passée au Fournisseur]
        ' Recopie du deuxième groupe de données vers le tableau cible
        'Range("TbMAJ[[Initiales Commercial]:[Initiales Produit9]]").Rows(LigneCible).Value = Range("TbCommande[[Initiales Commercial]:[Initiales Produit9]]").Rows(LigneSource).Value
        ' Recopie du 3ème groupe de données vers le tableau cible
        'Range("TbMAJ[[Toury Fermetures]:[Prospect]]").Rows(LigneCible).Value = Range("TbCommande[[Toury Fermetures]:[Prospect]]").Rows(LigneSource).Value
        ' Recopie du 4ème groupe de données vers le tableau cible
        'Range("TbMAJ[[DATE MODIFICATION]:[Init]]").Rows(LigneCible).Value = Range("TbCommande[[DATE MODIFICATION]:[Init]]").Rows(LigneSource).Value

    ' Ligne du tableau source suivante
    Next LigneSource
MsgBox "durée du traitement: " & Timer - start & " secondes"
End Sub

Merci beaucoup pour votre aide
Eric

 

[sylvanu]

Bonjour Eric,
Il eût été préférable d'expliquer quel était le but.
D'après ce que j'ai compris si une Ref Devis est trouvée on recopie la ligne dans MAJ, sinon on crée une ligne pour y stocker cette ligne.
Pour aller plus vite je suis passé par deux Arrays Source et Dest, ce qui me permet sur mon PC de passer de 19s à 1.6s.
Reste à savoir si ça fait ce que vous voulez. Mais au moins l'approche avec des arrays pourra vous inspirez.

 

[eric72]

Bonjour Eric,
Il eût été préférable d'expliquer quel était le but.
D'après ce que j'ai compris si une Ref Devis est trouvée on recopie la ligne dans MAJ, sinon on crée une ligne pour y stocker cette ligne.
Pour aller plus vite je suis passé par deux Arrays Source et Dest, ce qui me permet sur mon PC de passer de 19s à 1.6s.
Reste à savoir si ça fait ce que vous voulez. Mais au moins l'approche avec des arrays pourra vous inspirez.B

Bonjour Sylvanu,
En voulant simplifier j'ai crée un nouveau post et je me retrouve avec 2 posts , ce n'est pas très grave!!!
Merci pour votre réponse, sur mon fichier à 1250 lignes le temps est important également, vgendron a mis un code sur l'autre post qui parait très rapide:

Sub Transferer()
Dim i As Integer
Dim j As Integer
Dim Ind As Integer
Dim NbLig As Integer
Dim Trouvé As Boolean
Dim LigDest As Integer
Dim RefDev As String
Dim TSCommande As ListObject
Dim TSMaj As ListObject
Dim TabCommande() As Variant
Dim TabMaj() As Variant
Dim start As Single
start = Timer


    Set TSCommande = Sheets("Commande").ListObjects("TbCommande")
    Set TSMaj = Sheets("MAJ").ListObjects("TbMaj")
    
    With TSCommande
        TabCommande = .ListColumns(1).Range.Resize(, 10).Value
    End With
    
    With TSMaj
        TabMaj = Application.WorksheetFunction.Transpose(.ListColumns(1).Range.Resize(, 10).Value)
    End With
    NbLig = 0
    For i = LBound(TabCommande, 1) + 1 To UBound(TabCommande, 1)
        RefDev = TabCommande(i, 1)
        Trouvé = False
        For Ind = LBound(TabMaj, 2) + 1 To UBound(TabMaj, 2)
            If TabMaj(1, Ind) = RefDev Then
                LigDest = Ind
                Trouvé = True
                Exit For
            End If
            
        Next Ind
        If Not Trouvé Then
                NbLig = NbLig + 1
                ReDim Preserve TabMaj(1 To 10, 1 To NbLig + 1)
                LigDest = NbLig
            End If
        For j = 1 To 10
            TabMaj(j, LigDest) = TabCommande(i, j)
        Next j
    Next i
    
    With TSMaj
         .Range(1, 1).Resize(UBound(TabMaj, 2), UBound(TabMaj, 1)) = Application.WorksheetFunction.Transpose(TabMaj)
    End With
MsgBox "durée du traitement: " & Timer - start & " secondes"

End Sub

Le but est, à partir du tableau TbCommande, transférer les données dans TbMAJ.
-Si la RefDevis n'existe pas dans TbMAJ, on ajoute les données des colonnes de RefDevis à Init [[Référence Devis]:[Init]], puis les colonnes exemple de Pointage facture à Solde (pour exemple) etc...
-Si la Ref Devis existe on modifie les données des colonnes concernées sans toucher aux autre colonnes.
J'espère être assez clair...
Merci

 

[dysorthographie]

Bonjour,
Comme dit sur l'autre poste,il serait intéressant pour moi d'avoir quelques lignes de données bidon.

 

[eric72]

Bonjour,
Comme dit sur l'autre poste,il serait intéressant pour moi d'avoir quelques lignes de données bidon.

Voilà le fichier avec des données "bidon"

 

[eric72]

Je clôture cette discussion, les réponses sont sur l'autre discussion
Merci à tous