Optimisation Code suite grosse lenteur d'exécution
Bonjour la team,
Je m'excuse d'avance mais avant de commencer il est totalement impossible de mettre le fichier en PJ (Bloqué par la sécurité du TAF).
J'ai fait un code qui fonctionne très bien j'ai le résultat attendu sauf qu'il est hyper hyper lent.
Je trouve que c'est pas normale je sais pas si c'est le code qui n'est pas optimisé. Il doit consommer beaucoup de ressources ? j'ai mis un code pour supprimer le presse papiers mais sans succès.
Pour résumer le code consiste à checker toutes feuilles du classeur si la colonne A contient 0 alors copier la ligne le coller dans une feuille ainsi de suite à la fin il supprimer tous les doublons et réagence les colonnes etc......
L'exécution prend entre 10 minutes et 20 minutes parfois plus je sais pas pourquoi alors que c'est les même données. il y a environ une 40 feuilles pour environ 15 000 lignes
(il y a au total 3 codes dedans un code qui en appel un autre avec la commande Call)
Sub Externes()
'Réduire le temps d'exécution
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim wsITB As Worksheet
Dim lastRow As Long, destRow As Long
Dim i As Long
Dim Compteur&, total&, Msg$
'Message de téléchargement en cours"
' oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Traitement en cours veuillez patienter svp..."
' Effacer le Presse-papiers
Application.CutCopyMode = False
Cells(Application.Rows.Count, Application.Columns.Count).Copy
Application.CutCopyMode = False
'Position de la feuille
Sheets("Externes").Select
ActiveSheet.Cells.Clear
' Spécifiez le nom de la feuille Ext
Set wsITB = Sheets("Externes")
' Supprime les lignes de la 1ere à la dernière
wsITB.Rows("1:" & wsITB.Rows.Count).Delete
' Parcourez toutes les feuilles à partir de la 12ème
For Each ws In Worksheets
If ws.Index >= 12 Then
' Trouvez la dernière ligne dans la feuille en cours
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Parcourez la colonne A et copiez les lignes contenant 0
For i = 1 To lastRow
If ws.Cells(i, 1).Value = 0 And ws.Cells(i, 1) <> "" Then 'Vraiment égale à 0(zéro)
' Copiez la ligne à la dernière ligne de la feuille Externes
destRow = wsITB.Cells(wsITB.Rows.Count, "A").End(xlUp).Row + 1
ws.Rows(i).Copy wsITB.Rows(destRow)
Compteur = Compteur + 1 'incrémente le compteur
End If
Next i
Msg = Msg & ws.Name & " copie= " & Compteur & " ligne(s)" & vbLf
total = total + Compteur
Compteur = 0
End If
Next ws
If total = 0 Then Msg = Msg & vbLf & "Pensez à exécuter de nouveau la 1 ère Macro pour charger les données."
MsgBox Msg, , "Information" ' affiche le msgbox
' Effacer le Presse-papiers
Application.CutCopyMode = False
Cells(Application.Rows.Count, Application.Columns.Count).Copy
'Suppression des doublons colonne C
'ActiveSheet.UsedRange.RemoveDuplicates Columns:=3, Header:=xlYes
Call SupprimerDoublonsColonneC
' Affichez un message avec le nombre de lignes copiées
MsgBox "Nombre de lignes copiées dans la feuille Externes avant la suppression des doublons UT CODE : " & destRow - wsITB.Cells(2, 2).Row + 1
' Effacer le Presse-papiers
Application.CutCopyMode = False
Cells(Application.Rows.Count, Application.Columns.Count).Copy
Application.CutCopyMode = False
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
'Fin Réduction d'exécution
Application.ScreenUpdating = True
End Sub
Sub SupprimerDoublonsColonneC()
'Réduire le temps d'exécution
Application.ScreenUpdating = False
'Message de téléchargement en cours"
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Traitement en cours veuillez patienter svp..."
'Position de la feuille
Sheets("Externes").Select
Dim ws As Worksheet
Dim lastRow As Long
Dim rng As Range
Dim doublonsSupprimes As Long
Dim i As Long
' Spécifiez le nom de la feuille
Set ws = ThisWorkbook.Sheets("Externes")
' Trouver la dernière ligne dans la colonne C
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
' Initialiser le compteur de doublons supprimés
doublonsSupprimes = 0
' Parcourir toutes les lignes de la colonne C
For i = lastRow To 2 Step -1 ' On commence par la dernière ligne pour éviter les problèmes d'index lors de la suppression
' Vérifier si la valeur est un doublon
If WorksheetFunction.CountIf(ws.Range("C:C"), ws.Cells(i, "C").Value) > 1 Then
' Supprimer la ligne entière
ws.Rows(i).Delete
doublonsSupprimes = doublonsSupprimes + 1
End If
Next i
Call Supprimer_Colonnes
' Afficher le nombre de doublons supprimés
MsgBox doublonsSupprimes & " doublons ont été supprimés.", vbInformation
'Position de la feuille
Sheets("Externes").Select
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
'Fin Réduction d'exécution
Application.ScreenUpdating = True
End Sub
Sub Supprimer_Colonnes()
'Réduire le temps d'exécution
Application.ScreenUpdating = False
'Message de téléchargement en cours"
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Traitement en cours veuillez patienter svp..."
'ActiveSheet.UsedRange.RemoveDuplicates Columns:=3, Header:=xlYes
'Position de la feuille
Sheets("Externes").Select
'Suppression des colonnes non utilisées
Range( _
"A:A,B:B,D:D,E:E,H:H,K:K,L:L,N:N,O:O,P:P,Q:Q,R:R,S:S,T:T,U:U,V:V,W:W,X:X,Y:Y,Z:Z,AA:AA" _
).Select
Range("AA1").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
'Nommer les Entêtes
Range("A1").Select
ActiveCell.FormulaR1C1 = "UT CODE"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Last Name"
Range("C1").Select
ActiveCell.FormulaR1C1 = "First Name"
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D1").Select
ActiveCell.FormulaR1C1 = "Entity"
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Select
ActiveCell.FormulaR1C1 = "Contract type"
Columns("G:G").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Range("F1").Select
ActiveCell.FormulaR1C1 = "Product line"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Managers"
Range("H1").Select
ActiveCell.FormulaR1C1 = "HRE Contract begin date / SIN2022 Registration date"
' Effacer le Presse-papiers
Application.CutCopyMode = False
'Position de la feuille
Sheets("Externes").Select
Call ModifierFeuilleITBExternes
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
'Fin Réduction d'exécution
Application.ScreenUpdating = True
End Sub
Sub ModifierFeuilleITBExternes()
'Réduire le temps d'exécution
Application.ScreenUpdating = False
'Message de téléchargement en cours"
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Traitement en cours veuillez patienter svp..."
'Position de la feuille
Sheets("Externes").Select
Dim ws As Worksheet
Dim lastRow As Long
' Spécifiez la feuille de calcul concernée
Set ws = ThisWorkbook.Sheets("Externes")
' Mettez un remplissage bleu de A1 à H1 avec police en blanc et en gras
With ws.Range("A1:H1")
.Interior.Color = RGB(0, 0, 255) ' Bleu
.Font.Color = RGB(255, 255, 255) ' Blanc
.Font.Bold = True
End With
' Trouvez la dernière ligne utilisée dans la colonne A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Parcourez les lignes de la 2ème à la dernière
For i = 2 To lastRow
' Retirez le remplissage et réinitialisez la couleur de la police
ws.Rows(i).Interior.ColorIndex = xlNone ' Aucun remplissage
ws.Rows(i).Font.ColorIndex = xlAutomatic ' Réinitialisez la couleur de la police
Next i
' Sélectionne la dernière ligne de la colonne A
Range("A" & Rows.Count).End(xlUp).Select
'Position de la feuille
Sheets("Externes").Select
' Effacer le Presse-papiers
Application.CutCopyMode = False
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
'Fin Réduction d'exécution
Application.ScreenUpdating = True
End SubMerci d'avance pour votre expertise !!!!!!!
Hello,
Hum, est ce que tu ne pourrais pas passer par du PowerQuery pour aller chercher tes données ?
@+
Bonsoir à tous,
- Pour la suppression des doublons, RemoveDuplicates ne convient pas ? Il est beaucoup plus rapide que ta boucle...
- Pour le rapatriement des données, vu le nombre conséquent de lignes, il va falloir travailler en mémoire donc passer un tableau.
- Ta boucle pour la réinitialisation des couleurs et police est inutile, en définissant une plage ,tu peux faire directement:
plage.Interior.ColorIndex = xlNone ' Aucun remplissage
plage.Font.ColorIndex = xlAutomatic ' Réinitialisez la couleur de la police- Pas trop compris ce que tu faisais avec tes réorganisations de colonnes...
Il doit y avoir moyen de tout compiler en un seul code, en procédant chronologiquement.
Si ton fichier correspond à ta précédente demande, tu peux peut-être mettre des données bidon (quelques lignes seulement) et montrer le résultat attendu sur la feuille Externes ?
Difficile sans fichier ...
Cordialement,
bonjour
tu m'etonne qu'il est lent
en vba il y a les bonnes pratiques et les mauvaises
dans ton code tu colectionnes les mauvaise pratiques et celà jusqu'a la fin du code
prends un momment tranquillelis cette partie de ton code
et dit toi à haute voix (ou dans ta tête comme tu veux)
tu va voir tes ampoules vont s'allumer
' Effacer le Presse-papiers
Application.CutCopyMode = False
Cells(Application.Rows.Count, Application.Columns.Count).Copy
Application.CutCopyMode = False
'Position de la feuille
Sheets("Externes").Select
ActiveSheet.Cells.Clear
' Spécifiez le nom de la feuille Ext
Set wsITB = Sheets("Externes")
' Supprime les lignes de la 1ere à la dernière
wsITB.Rows("1:" & wsITB.Rows.Count).Deletenormalement je le fais pas mais il y a beaucoup de chose à voir on va avancer un peu
je te traduit ton code en francais
' Effacer le Presse-papiers
Application.CutCopyMode = False ' vide le clipboard
Cells(Application.Rows.Count, Application.Columns.Count).Copy ' copy toute la feuille hhurrrgghhh!!!
Application.CutCopyMode = False 'vide le clipboard
'Position de la feuille '?????????????
Sheets("Externes").Select 'selection de la feuille( à ne surtout pas faire )
ActiveSheet.Cells.Clear ' la c'est le comble tu vide la feuille complete
' Spécifiez le nom de la feuille Ext
Set wsITB = Sheets("Externes") ' la tu decide a peut être travailler correctement
' Supprime les lignes de la 1ere à la dernière
wsITB.Rows("1:" & wsITB.Rows.Count).Delete ' a ben non la c'est pire tu cherche a supprimer des eventuelles lignes pleine alors que tu la vidé précédemment re
et encore ici par exemple
'Position de la feuille
Sheets("Externes").Select
'Suppression des colonnes non utilisées
Range( _
"A:A,B:B,D:D,E:E,H:H,K:K,L:L,N:N,O:O,P:P,Q:Q,R:R,S:S,T:T,U:U,V:V,W:W,X:X,Y:Y,Z:Z,AA:AA" _
).Select
Range("AA1").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
'Nommer les Entêtes
Range("A1").Select
ActiveCell.FormulaR1C1 = "UT CODE"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Last Name"
Range("C1").Select
ActiveCell.FormulaR1C1 = "First Name"tu peux pas faire ça plutot
with Sheets("Externes")
'Suppression des colonnes non utilisées
Range("A:A,B:B,D:D,E:E,H:H,K:K,L:L,N:N,O:O,P:P,Q:Q,R:R,S:S,T:T,U:U,V:V,W:W,X:X,Y:Y,Z:Z,AA:AA").Delete Shift:=xlToLeft
'Nommer les Entêtes
[A1] = "UT CODE"
[B1] = "Last Name"
[C1] = "First Name"
Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
[D1] = "Entity"
Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
[E1] = "Contract type"
'te reste a faire pareil pour la suite
'...
'...'
'...
end withbref il ya du boulot
Bonsoir à tous
Difficile sans fichier. Je me suis amusé (enfin au début
- Bouton Vert : initialiser avec des données les feuilles F12 à F51
- Bouton bleu : lancer le traitement
La partie suppression de colonnes (sauf la suppression des colonnes de A à AA - qui semble clair) et l' insertion de colonnes sur la feuilles "Externes" doivent se faire sur le fichier réel (pour pouvoir vérifier de visu) et être adaptée (sans fichier c'est 'coton' - surtout que ce n'est pas très clair pour moi).
Après les suppressions puis les insertions de colonnes, on inscrit les en-têtes finaux (en utilisant la constante Entete).
Sur ma bécane, l’exécution dure environ 1,5 s pour 40 feuilles (500 lignes par feuille)
Re à tous,
Dans mon précédent message, je n'ai pas joint le bon fichier. Excusez moi.
Voir le fichier v2.
Bonsoir à tous
TOUT D'ABORD MERCI BEAUCOUP POUR VOTRE AIDE
je sais que c'est pas facile sans fichier désolé pour ça du coup j'en ai crée un qui reprend un peu mon besoin avec le code
@BAROUTE78 : Malheureusement non je peux pas trop de sécurité :(
@xorsankukai : Effectivement, il s'agit d'un code que j'exécute en Amont mais qu'il me satisfait pas trop novice je sais que j'alourdie le code
@patrick T : Oui je suis novice j'essai de bricoler un peu ça marche mais pas optimisé :(
@mafraise : Mille merci pour ton retour j'étudie ton code (très intéressant) c'est presque ça.
Je viens de créer un fichier qui reprend un peu mon besoin avec le code
Encore merci pour votre expertise
Re,
Pour résumer,
1 ==> je lui dit de checker toutes les feuilles à partir de la 12eme feuille dans la colonne A si tu as le chiffre 0 alors tu copie la ligne et tu la colle dans la feuille All_Name
2 ==> Puis dans la feuille All_Name si tu as une ligne en doublons supprime 1 ligne (besoin que d'une ligne uniquement)
exemple :
| 0 | aaren | a | FR | RA | CO | DO | LOT | RC | HI | PC | AL | RE | RP | CO | DO | LOT | RC | HI | PC | AL | RE | RP | RI | RC | 1 | EN COURS |
| 0 | aarne | a | FR | RA | CO | DO | LOT | RC | HI | PC | AL | RE | RP | CO | DO | LOT | RC | HI | PC | AL | RE | RP | RI | RC | 1 | EN COURS |
****Sauf que la je viens de remarquer que la suppression de doublons ne fonctionne pas j'ai refait une modification ça fonctionne bien je remet la PJ
3 ==> Puis en 3 je veux conserver que la colonne C F G I J M le reste je supprime puis je renomme les entêtes puis les couleur ......
bon j'ai trouvé le moyen de copier toutes tes feuilles en moins 0.250 secondes
maintenant j'ai un soucis
tu veux suprimer les doublons de la colonne "C" mais la colonne "C" c'est la colonne "Classe" et il n'y a que des "a"
ca serait pas plutot la "B" ou il y a les prenoms ?????
est ce que c'est cela que tu veux
je peux te le proposer en tableau structuré à la sortie si tu veux
Bonjour,
Je crois que tu as fait mon W-E avec ta réponse à Baroute...
Bonsoir à tous
@BAROUTE78 : Malheureusement non je peux pas trop de sécurité :(
Je doute de trouver une entreprise qui autorise le VBA et interdise Power Query - Je pencherais même pour l'inverse...
Bon courage dans tes recherches, et bon W-E
re
Bonjour @cousinhub
je peux te confirmer que certaines entreprise(ou organisme d'etat) interdisent les requetes web par PQ
d'ailleurs si on va bien chercher aujourd'hui une requetes web par VBA et bien plus difficile par VBA que PQ
je peux t'en parler la ou je le fait les doigts dans le nez avec PQ ,en vba c'est mort
moi j'ai une question pour @tonton95
tu veux
B | C | F | entity | I | Product line | J | M
ou
B | C | F | entity | J | Product line | I | M
parce que avec tes suppression de colonnes on a le 2d
comme je ne (coupe plus / inserte plus) il me faudrait l'ordre que tu désire
pour info moins d'une seconde pour faire le job actuellement d'un bout à l'autre
copie des colonnes , entetes , couleur ou tableau structuré c'est au choix
voila j'attends ta reponse
Re-,
re
Bonjour @cousinhub
je peux te confirmer que certaines entreprise(ou organisme d'etat) interdisent les requetes web par PQ
d'ailleurs si on va bien chercher aujourd'hui une requetes web par VBA et bien plus difficile par VBA que PQ
je peux t'en parler la ou je le fait les doigts dans le nez avec PQ ,en vba c'est mort
Euh, on ne parle pas de la même chose...
Je n'ai jamais fait allusion à une quelconque requête SUR le web, juste à son utilisation.
Par contre, tu nous apprends une grande nouvelle, TU utilises PQ...
au boulot oui puisque je l'ai( et ce n'est pas moi qui decide ) , a la maison non j'en veux pas ;vbiste jusqu'a la mort
le json chez moi c'est dans un object script
ca d'ailleurs été un debat au boulot (les pours et les contres)
on travaille beaucoup avec des revendeurs de trames de formations et exercice en tout genre,pour nos jeunes
test vacog, fenêtre de johari,exercice de logique,Actu,developpement perso,escape game,etc....
et on telecharge des tableaux par PQ
sauf que la D générale a mis le Hoh là nous a demandé si il n'y avait pas de blob contacter le revendeur et demander un exemplaire pdf ou excel
conclusion: PQ est mort chez nous
Bonjour patrickT
patrickT a dit,
test vacog, fenêtre de johari,exercice de logique,Actu,developpement perso,escape game,etc....
Que des machins que j'adore
Ca me rappelle un stage de conduite sur route mouillée. A la fin, on arrive bien à freiner sur route glissante sans écraser le p'ti vieux et on en est fier. Et le formateur a conclut : de toute manière au premier freinage d'urgence vous vous planterez. Vous ne croyez pas sérieusement que sans un apprentissage long et une pratique régulière, vous allez devenir des as de rallye ! Vos vieux mauvais réflexes ressurgiront et le p'tit vieux volera dans les airs. Alors en plus quand il s'agit de s'attaquer à sa nature profonde...
Bonjour la team,
Merci à vous pour le sacrifice de votre temps en ce week end
@cousinhub beaucoup de truc son verrouillé (ce qui me facilite pas la tache) et vue vos échanges avec @patrick T et @mafraise j'ai clairement pas le même niveau
@patrick T un grand merci pour ton retour. Je reformule mon besoin en essayant d'être un peu plus claire (je me suis basé sur le dernier fichier que j'ai mis en PJ)
==> Dans la feuille All_Name il faut supprimer toutes les colonnes sauf :
Colonne C nommé "Classe" que je renomme "ID" (
Colonne F nommé "1C" que je renomme "Nom"
Colonne G nommé "2C" que je renomme "Prénom"
Colonne I nommé "4C" que je renomme "Manager"
Colonne J nommé "5C" que je renomme "Contract"
Puis il faut rajouter 2 colonnes qui n'apparait pas dans le tableau (car ces données sont rajoutés à posteriorie) "entity" et "producte line"
1 : Suppression des colonnes sauf :
2 : Après rajout "Entity" et Product Line"
3 : Résultat final de la feuille All_Name en les renommant
J'espère que c'est un peu plus claire
Merci encore pour votre expertise
re
ok donc je récapitubidule
| C devient ID | F devient nom | G devient préénom | nouvelle colonne entity | J devient contract | nouvelle colonne devient prductline | i devient manager |
c'est OK ou pas ?
re
@mafraise
oui aux premier abords on pourrait dire que c'est de la conneries
certaines d'ailleurs le sont
mais quand je vois le résultat; de jeunes a priori perdus
et que je les vois monter leur petite boite
je me dis que j'ai pas perdu mon temps
quand au salaire faut pas réver je gagnais mieux avant en etant à mon compte
mais on arrive à un âge où cette question résonne plus fort dans la tête
à savoir: transmettre , accompagner vers la réussite
bref remonter dans le haut du panier
je te cache pas que j'ai des echecs
pour certains qui sont tellement C.. je vois que l'heutanasie (mince c'est interdit)
Re
Attention l'humour même noir (de couleur pardon) est souvent mal pris en ces temps d'inclusion.
Sinon, je ne pensais pas aux jeunes mais aux très grosses boites qui embrayent sur ce que font surtout les américains (avec quelques années de retard de retard) et qui y envoient leurs salariés (pardon il faut dire collaborateurs) volontaires ou pas. A priori toi tu fais du sauvetage de jeunes avec l'avantage de voir quelquefois leur réussite (ceci entretient la flamme) et ça compense les cas où ça ne réussit pas. Je crois que tu as raison : quand on avance en âge les priorités et valeurs changent un peu. D'où l'expression des jeunes nous traitant de "vieux cons". "Vieux" c'est oui, "con" c'est oui, "vieux con" c'est non !