Microsoft 365 Programme trop lent

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
 

Deadpool_CC

XLDnaute Impliqué
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.
 

manue971

XLDnaute Nouveau
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.
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

  • Modèle.xlsx
    31.1 KB · Affichages: 6

Deadpool_CC

XLDnaute Impliqué
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:

Phil69970

XLDnaute Barbatruc
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é

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.
Et moi je vois sur le 1er tableau
1656679642976.png

Il manque 6 colonnes

Et moi je vois dans le 2eme tableau 26 colonnes
1656679443536.png

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 o_O
Le problème c'est que pour un tableau de 569 lignes, le programme tourne pendant 3h!

@Phil69970
 

soan

XLDnaute Barbatruc
Inactif
Bonsoir,

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..??

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
 

Hasco

XLDnaute Barbatruc
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

  • PQ-Modèle.xlsx
    57.5 KB · Affichages: 4
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
302 099
Messages
2 000 397
Membres
214 832
dernier inscrit
CoLoRzE