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

Microsoft 365 Programme trop lent

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion manue971
  • 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
M

manue971

XLDnaute Nouveau
Bonjour à tous,

J'ai créé la macro suivante qui est censée transposer les données en ligne, à partir de la colonne 25 (avec un max de 23 colonnes à transposer).
Les 24 1ere colonnes sont répétées sur chacune des lignes transposées.
Le problème c'est que pour un tableau de 569 lignes, le programme tourne pendant 3h!
Auriez-vous une proposition pour accélérer le traitement?
Merci d'avance!

Sub Transposition2021()

'stocker le moment de début
Dim MacroDebut As Date
MacroDebut = Now

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Délaration du classeur
Set Classeur = ThisWorkbook
Dim sNomClasseur As String
sNomClasseur = Classeur.Name

'Supprime l'onglet EXPORT REVIENT
Workbooks(sNomClasseur).Activate
On Error Resume Next
Sheets("EXPORT REVIENT").Delete

'Actualise la requête
Workbooks(sNomClasseur).Queries.Item("GLOBAL REVIENT").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

'Suppression des colonnes
Dim table As ListObject

Set table = ActiveSheet.ListObjects("GLOBAL REVIENT")

'Délimite le tableau
Range("A1").Select
derlig = Cells(Cells.Rows.Count, 1).End(xlUp).Row
DerCol = Cells(1, Columns.Count).End(xlToLeft).Column

'Récupérer la plage du tableau
Dim pTableau As Range

'Converti la plage en nombre
Sheets("GLOBAL REVIENT").Range(Cells(2, 25), Cells(derlig, DerCol)).Select
With Selection
.NumberFormat = "0.00"
.Value = .Value
End With

Range("A1").ClearContents

Set pTableau = Sheets("GLOBAL REVIENT").Range(Cells(2, 25), Cells(derlig, DerCol))

'Creer la liste
Dim lignetitre As Integer, colonnetitre As Integer
Dim ligne As Integer, colonne As Integer
Dim cellule As Range
Sheets.Add(After:=Sheets("GLOBAL REVIENT")).Name = "EXPORT REVIENT"
Set cellule = Sheets("EXPORT REVIENT").Range("A2")
Sheets("EXPORT REVIENT").Cells.ClearContents
Range("A1") = "Numéro_dossier_import"
ActiveCell.Offset(0, 1) = "Filiale"
ActiveCell.Offset(0, 2) = "Date_de_chargement"
ActiveCell.Offset(0, 3) = "Compagnie_maritime"
ActiveCell.Offset(0, 4) = "Navire"
ActiveCell.Offset(0, 5) = "Numéro_de_voyage"
ActiveCell.Offset(0, 6) = "POL"
ActiveCell.Offset(0, 7) = "POD"
ActiveCell.Offset(0, 8) = "Numéro_du_BL"
ActiveCell.Offset(0, 9) = "Taille"
ActiveCell.Offset(0, 10) = "EVP"
ActiveCell.Offset(0, 11) = "Type_TC"
ActiveCell.Offset(0, 12) = "Circuit_Import"
ActiveCell.Offset(0, 13) = "Numéro_conteneur"
ActiveCell.Offset(0, 14) = "Flux"
ActiveCell.Offset(0, 15) = "Poids_TONNES"
ActiveCell.Offset(0, 16) = "Volume_chargement"
ActiveCell.Offset(0, 17) = "Volume_global"
ActiveCell.Offset(0, 18) = "N°_CDE"
ActiveCell.Offset(0, 19) = "Date_arrivée"
ActiveCell.Offset(0, 20) = "Liste_Fournisseurs"
ActiveCell.Offset(0, 21) = "Nb_de_palettes"
ActiveCell.Offset(0, 22) = "Date_de_validation"
ActiveCell.Offset(0, 23) = "Taux_Assurance"
ActiveCell.Offset(0, 24) = "Dépense"
ActiveCell.Offset(0, 25) = "Montant"

lignetitre = pTableau.Cells(1).Row
colonnetitre = pTableau.Cells(1).Column
ligne = Sheets("GLOBAL REVIENT").Cells(1).Row
Numéro_dossier_import = Sheets("GLOBAL REVIENT").Cells(1).Column
Filiale = Sheets("GLOBAL REVIENT").Cells(2).Column
Date_de_chargement = Sheets("GLOBAL REVIENT").Cells(3).Column
Compagnie_maritime = Sheets("GLOBAL REVIENT").Cells(4).Column
Navire = Sheets("GLOBAL REVIENT").Cells(5).Column
Numéro_de_voyage = Sheets("GLOBAL REVIENT").Cells(6).Column
POL = Sheets("GLOBAL REVIENT").Cells(7).Column
POD = Sheets("GLOBAL REVIENT").Cells(8).Column
Numéro_du_BL = Sheets("GLOBAL REVIENT").Cells(9).Column
Taille = Sheets("GLOBAL REVIENT").Cells(10).Column
EVP = Sheets("GLOBAL REVIENT").Cells(11).Column
Type_TC = Sheets("GLOBAL REVIENT").Cells(12).Column
Circuit_Import = Sheets("GLOBAL REVIENT").Cells(13).Column
Numéro_conteneur = Sheets("GLOBAL REVIENT").Cells(14).Column
Flux = Sheets("GLOBAL REVIENT").Cells(15).Column
Poids_TONNES = Sheets("GLOBAL REVIENT").Cells(16).Column
Volume_chargement = Sheets("GLOBAL REVIENT").Cells(17).Column
Volume_global = Sheets("GLOBAL REVIENT").Cells(18).Column
N°_CDE = Sheets("GLOBAL REVIENT").Cells(19).Column
Date_arrivée = Sheets("GLOBAL REVIENT").Cells(20).Column
Liste_Fournisseurs = Sheets("GLOBAL REVIENT").Cells(21).Column
Nb_de_palettes = Sheets("GLOBAL REVIENT").Cells(22).Column
Date_de_validation = Sheets("GLOBAL REVIENT").Cells(23).Column
Taux_Assurance = Sheets("GLOBAL REVIENT").Cells(24).Column

Dim celluletableau As Range
For Each celluletableau In pTableau
If celluletableau > 0 Then
cellule = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Numéro_dossier_import).Value
cellule.Offset(0, 1) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Filiale).Value
cellule.Offset(0, 2) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Date_de_chargement).Value
cellule.Offset(0, 3) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Compagnie_maritime).Value
cellule.Offset(0, 4) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Navire).Value
cellule.Offset(0, 5) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Numéro_de_voyage).Value
cellule.Offset(0, 6) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, POL).Value
cellule.Offset(0, 7) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, POD).Value
cellule.Offset(0, 8) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Numéro_du_BL).Value
cellule.Offset(0, 9) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Taille).Value
cellule.Offset(0, 10) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, EVP).Value
cellule.Offset(0, 11) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Type_TC).Value
cellule.Offset(0, 12) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Circuit_Import).Value
cellule.Offset(0, 13) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Numéro_conteneur).Value
cellule.Offset(0, 14) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Flux).Value
cellule.Offset(0, 15) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Poids_TONNES).Value
cellule.Offset(0, 16) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Volume_chargement).Value
cellule.Offset(0, 17) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Volume_global).Value
cellule.Offset(0, 18) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, N°_CDE).Value
cellule.Offset(0, 19) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Date_arrivée).Value
cellule.Offset(0, 20) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Liste_Fournisseurs).Value
cellule.Offset(0, 21) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Nb_de_palettes).Value
cellule.Offset(0, 22) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Date_de_validation).Value
cellule.Offset(0, 23) = Sheets("GLOBAL REVIENT").Cells(celluletableau.Row, Taux_Assurance).Value
cellule.Offset(0, 24) = Sheets("GLOBAL REVIENT").Cells(ligne, celluletableau.Column).Value
cellule.Offset(0, 25) = celluletableau
Set cellule = cellule.Offset(1, 0)
End If

Next

'Converti en tableau structuré
ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).Name = _
"Tableau1"

'Enregistre le fichier
ActiveWorkbook.Save

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True


'la fin de l'exécution
MacroFin = Now

'calcul & mise en forme des durées des étapes
MacroTotal_duree = Format(MacroFin - MacroDebut, "hh:mm:ss")
MsgBox "VOS FICHIERS ONT ÉTÉ EXPORTÉS EN : " & MacroTotal_duree

End Sub
 
Trier par date Trier par votes
Bonjour,

sans fichier exemple cela va être dur
mais pouquoi t'as pas utilisé la fonction de copie d'excel avec l'option transposition ?
fait le à la main en registrant la macro ... tu verra le code et tu pourra ensuite le "nettoyer/optimiser" si besoin.
 
Vote positif 0 Vote négatif
Salut désolée du retour tardif, mais j'essayais de trouver une solution sur POWER QUERY.
Je ne peux pas faire une simple transposition car le tableau a 47 colonnes, or je ne veux transposer que les 23 dernières.
Ce qui signifie, que que chaque ligne des 24 premières colonnes doit être répétée.
En pièce jointe un modèle de fichier. Onglet 1 = tableau initial, Onglet 2 = résultat macro.
Merci d'avance
 

Pièces jointes

Vote positif 0 Vote négatif
Pas trop le temps de faire dans l'immédiat un autre code VBA plus rapide à l'exécution
mais déjà en simple lecture :
* ton code vba post#1 n'a pas les mêmes noms de feuilles que le fichier exemple.
* la suppression de la feuille export et sa reconstruction (à priori) à l'identique ... c'est obligatoire ? (on ne peut pas se contenter de faire une suppression du contenu de ton tableau structuré "tableau1" pour y mettre les nouvelles données ?
* rapide comparaison des colonnes : dans ta feuille "Export Revient2021" les 2 dernières col. ("Dépense" et "Montant") ne semblent pas issues du tableau d'origine dans "Global Revient2021"
j'ai pas encore regarder le code plus avant mais c'est des données des 2 dernières col. semble remplie par une logique diff. du simple copier/coller d'un tableau vers l'autre.

* les titres de Colonne => d'un tableau à l'autre les espaces sont remplacer par "_" et que "/" disparait. ... Le fait qu'elle n'ai pas strictement la même orthographe est voulue/obligatoire ?

En attendant que j'ai un peu de temps, n'hésites pas à préciser le mode opératoire pour qu'on (moi ou une autre bonne âme) trouve la solution la plus rapide pour le faire. 🙂

[Edit] sans parler de l'optimisation sur le reste de ton code qui peut être réalisée. 🙂

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Bonjour à tous
Edit : Bonjour @Deadpool_CC
Grosso modo tu fais une partie des même me remarque que moi 🤣

@manue971

il manque un peu de rigueur dans ton énoncé

manue971 à dit:
Je ne peux pas faire une simple transposition car le tableau a 47 colonnes, or je ne veux transposer que les 23 dernières.
Ce qui signifie, que que chaque ligne des 24 premières colonnes doit être répétée.
Cliquez pour agrandir...
Et moi je vois sur le 1er tableau

Il manque 6 colonnes

Et moi je vois dans le 2eme tableau 26 colonnes

A priori il faut juste recopier les 24 premières colonnes mais que faire de la 25 eme et 26 eme colonne on prend qu'elle valeur ?
Que vient faire le 23 dans cette histoire ?

De plus comme tu as 2 tableaux structurés j’espère qu'ils ont le même nom dans ton fichier réel car autrement rien ne fonctionnera !!!

Alors mets nous un fichier avec les 2 feuilles correctes

*Pour copier 569 lignes normalement on ne doit pas dépasser la demi seconde et encore sur un vieux PC 😵
manue971 à dit:
Le problème c'est que pour un tableau de 569 lignes, le programme tourne pendant 3h!
Cliquez pour agrandir...

@Phil69970
 
Vote positif 0 Vote négatif
Bonsoir,

vgendron à dit:
je ne comprends pas le principe de commencer un post avec une macro à rallonge sans fichier
puis ensuite poster un fichier qui n'a aucune donnée, et ne contient même pas ladite macro..??
Cliquez pour agrandir...

je suis entièrement d'accord avec vgendron ! d'où cette question : est-ce la macro qui a perdu son fichier ou est-ce le fichier qui a perdu sa macro ? en d'autres termes : qui vient en premier ? l'œuf ou la poule ? 🤪

d'autre part, ça aurait été bien mieux de mettre la macro à rallonge de l'énoncé entre balises de code !​

soan
 
Vote positif 0 Vote négatif
Bonjour,

Une tentative Power Query sur le fichier du post#3 j'ai enlevé les Alea.Entre.Bornes.

Dépivote les dernières colonnes (26 à n) et conserve les 25 premières

Cordialement
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re,
@Staple1600 : heureux de te revoir 🙂
Dans la première version et la V2, je me fourvoyais 😵... une nuit de repos et tout est redevenu clair et limpide😇...

M'enfin de mes erreurs j'ai encore appris quelques chose.

Cordialement
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
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

J
  • Question Question
Macro reliant outlook, problème de conversion de 2003 à 2010.
Réponses
0
Affichages
1 K
Jojolapin
J
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…