Microsoft 365 duree macro trop longue

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion eric72
  • 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
E

eric72

XLDnaute Accro
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!!!
Merci beaucoup pour votre aide
Eric
 
Solution
vgendron
avec CE code
si la table maj est VIDE (meme pas une ligne==> tu as donc fait un delete sur TOUTES les lignes de la table ==> ca fonctionne bien
si la table maj contient déjà toutes les lignes, = les nouvelles lignes sont bien ajoutées
si la table maj contient AU MOINS 2 lignes ==> idem
si la table Maj ne contient qu'UNE seule ligne ==> apparition des 138 ref ==> c'est à cause de la fonction transpose qui ne SAIT pas transposer une seule ligne en une seule colonne ==> solution s'assurer d'avoir toujours au moins 2 lignes ( elles peuvent etre vide)
VB: 
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...
Trier par date Trier par votes
Hello eric72,
tu as posté une pièce jointe qui contient des données confidentielles, telles que des informations d'une entreprise, des noms prénoms de personnes réelles, des numéros de téléphones,...
supprime ta pièce jointe et met seulement ton code dans le forum
Je l'ai téléchargé et voici ce que cela donne en temps chez moi :
IDnr Name Time sum
0 Init 69 us
1 Find 117,5 s
2 cellule Trouvée 74 ms
3 Recopie 36 s
TOTAL 153,5 s
Je détruis le fichier à présent.
Profites en pour relire la charte.
Ami calmant, J.P
 
Vote positif 0 Vote négatif
jurassic pork à dit:
Hello eric72,
tu as posté une pièce jointe qui contient des données confidentielles, telles que des informations d'une entreprise, des noms prénoms de personnes réelles, des numéros de téléphones,...
supprime ta pièce jointe et met seulement ton code dans le forum
Je l'ai téléchargé et voici ce que cela donne en temps chez moi :
IDnr Name Time sum
0 Init 69 us
1 Find 117,5 s
2 cellule Trouvée 74 ms
3 Recopie 36 s
TOTAL 153,5 s
Je détruis le fichier à présent.
Profites en pour relire la charte.
Ami calmant, J.P
Cliquez pour agrandir...
Bonjour jurassic pork,
Merci pour ta réponse,
en fait c'est une requête power query qui s'est executée mais pas grave ce sont des données eronnées pour exemple, merci quand même!!!
Ma question était de savoir s'il était possible de réduire le temps d'exécution?
Merci
 
Vote positif 0 Vote négatif
Bonjour à tous,
Je mets le code au cas ou:
VB: 
Sub Copier_Valeurs()


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
'Stop
    ' 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]:[Conf. Comm. Client]]").Rows(LigneCible).Value = Range("TbCommande[[Référence Devis]:[Conf. Comm. Client]]").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
 
End Sub
 
Vote positif 0 Vote négatif
vgendron à dit:
Hello

le but de la macro c'est quoi?
copier les entrées de commande vers MAJ seulement si elles n'y sont pas déjà?
Cliquez pour agrandir...
Bonjour Vgendron,
Merci de ta réponse, oui en effet c'est bien de copier les données vers MAJ si elles n'existent pas, ou les modifier si la Refdevis existe dans MAJ, et en plus pas toutes les colonnes, uniquement certaines colonnes, exemple de Range("TbMAJ[[Référence Devis]:[Init]]"), puis ensuite certaines autres colonnes.
 
Vote positif 0 Vote négatif
Un essai avec des tablo

VB: 
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
        .DataBodyRange(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
 
Vote positif 0 Vote négatif
vgendron à dit:
Un essai avec des tablo

VB: 
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
        .DataBodyRange(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
Cliquez pour agrandir...
Merci beaucoup,
j'ai juste une erreur 91 ici:
VB: 
        .DataBodyRange(1, 1).Resize(UBound(TabMaj, 2), UBound(TabMaj, 1)) = Application.WorksheetFunction.Transpose(TabMaj)
 
Vote positif 0 Vote négatif
eric72 à dit:
Merci beaucoup,
j'ai juste une erreur 91 ici:
VB: 
        .DataBodyRange(1, 1).Resize(UBound(TabMaj, 2), UBound(TabMaj, 1)) = Application.WorksheetFunction.Transpose(TabMaj)
Cliquez pour agrandir...
oui moi aussi lorsque la TS tbMaj est totalement vide et que la première ligne n'existe pas (meme si visible)
tape n'importe quoi dans la première ligne (pour crééer la ligne) et efface (pas de delete)
et relance
 
Vote positif 0 Vote négatif
et pour éviter la recopie de la ligne d'entete (à chaque fois que tu relances la macro..) il faut corriger avec ceci

VB: 
 With TSMaj
        .Range(1, 1).Resize(UBound(TabMaj, 2), UBound(TabMaj, 1)) = Application.WorksheetFunction.Transpose(TabMaj)
    End With
 
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

E
  • Résolu(e)
Microsoft 365 Reduire Temps Execution Code
Réponses
5
Affichages
283
eric72
E
A
  • Question Question
XL 2016 Procédure trop longue pour une macro existante
2
Réponses
16
Affichages
2 K
ChTi160
ChTi160
V
  • Question Question
Macro d'export de donnée : erreur 1004
Réponses
5
Affichages
1 K
Roland_M
Roland_M
R
  • Question Question
macro remplissage cellule par incrémentation suivant plusieurs valeurs
Réponses
6
Affichages
3 K
racoune
R
S
  • Question Question
[Résolu] Petite macro simple avec une double boucle sur ligne pour très gros fichier
2
Réponses
27
Affichages
6 K
stephsteph
S
M
  • Question Question
Macro trop longue
Réponses
6
Affichages
2 K
Tirou
T
W
  • Question Question
Recalcul automatique par macro qui ne fonctionne pas
Réponses
2
Affichages
1 K
whiskyfizz
W
B
  • Question Question
code VBA execution trop longue
Réponses
9
Affichages
3 K
bigmousse
B
S
  • Question Question
Formule par macro trop longue
Réponses
5
Affichages
1 K
sebastien450
S
SaM`
  • Question Question
[MACRO] Report du Solde
Réponses
4
Affichages
2 K
SaM`
SaM`
M
[REF] Wiki Page 9 de MichelXld
Réponses
0
Affichages
39 K
MichelXld
M
M
[REF] Wiki Page 7 de MichelXld
Réponses
0
Affichages
51 K
MichelXld
M
M
[REF] Wiki 5 de MichelXld (Formules, Audits de formules, Répertoires, Fichiers)
Réponses
0
Affichages
47 K
MichelXld
M
Retour