Fichier Excel macro de plus en plus lent
Salut Nico,
voici déjà une première fournée à tester et à coller (tout remplacer) dans la copie de ton fichier de travail.
Dans THISWORKBOOK
- Workbook_Open() vérifie la validité des dates en 'STOCK' [F:F] ( sinon couleur orange en [B:C:D]) ;
- Workbook_SheetBeforeRightClick() t'envoie à la dernière ligne de chaque feuille si tu clic-droit sur la 1e ligne ;
Private Sub Workbook_Open()
'
Application.ScreenUpdating = False
'
With Worksheets("STOCK")
iRow = .Range("F" & Rows.Count).End(xlUp).Row
For x = 2 To iRow
If Cells(x, 6) <> "" And CDate(Cells(x, 6)) < Date Then .Range("B" & x & ":D" & x).Interior.Color = RGB(255, 190, 0)
Next
.Activate
End With
'
Application.ScreenUpdating = True
'
End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'
If Not Intersect(Target, Range("A1:K1")) Is Nothing Then
Cancel = True
ActiveWindow.ScrollRow = Sh.Range("A" & Rows.Count).End(xlUp).Row
End If
'
End SubDans STOCK
Plus besoin de basculer vers GIMENEZ (voir ci-dessous).
- Worksheet_BeforeDoubleClick() en [L:L] transfère les lignes vers la feuille correspondant à la cellule cliquée.
a) si TRANSPORT, copie des lignes si [B:C:D] n'est pas en orange ;
b) si AFFECTATION, copie vers une nouvelle feuille 'CVVO' où elles sont triées selon l'immatriculation avant d'être envoyées vers 'AFFECTATION'.
- Worksheet_Change()
a) quand tu écris CARGO, DIAC LOC ou REPRISE, la cellule en [L:L] affiche directement AFFECTATION ;
b) quand tu écris EST, NORD ou RILLIEUX, les cellules se colorent via macro ;
- Contrats() colore EST NORD RILLIEUX
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim sWk As Worksheet
Dim sData As String
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
Cancel = True
Set sWk = Worksheets("STOCK")
'
If Not Intersect(Target, Range("L:L")) Is Nothing And Target <> "" Then
sData = CStr(Target)
If sData = "AFFECTATION" Or sData = "TRANSPORT" Or sData = "SUD" Then
iRowT = Range("A" & Rows.Count).End(xlUp).Row
With Worksheets(Switch(sData = "AFFECTATION", "CVVO", sData = "TRANSPORT", "TRANSPORT", sData = "SUD", "VO SUD"))
iRow = .Range("A" & Rows.Count).End(xlUp).Row
If sData = "AFFECTATION" Then
.UsedRange.Clear
iRow = 0
End If
For x = iRowT To 2 Step -1
If sWk.Cells(x, 12) = sData And sWk.Cells(x, 2).Interior.Color <> RGB(255, 190, 0) Then
iLig = iLig + 1
sWk.Range("A" & x & ":L" & x).Copy Destination:=.Range("A" & iRow + iLig & ":L" & iRow + iLig)
sWk.Rows(x).Delete shift:=xlUp
If sData <> "AFFECTATION" Then .Range(IIf(sData = "SUD", "N", "Q") & iRow + iLig) = Date
End If
If x = 2 And sData = "AFFECTATION" Then
.Range("A1:L" & iLig).Sort key1:=.Range("C1"), order1:=xlAscending, Orientation:=xlTopToBottom
iRow = Worksheets("AFFECTATION").Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:L" & iLig).Copy Destination:=Worksheets("AFFECTATION").Range("A" & iRow + 1 & ":L" & iRow + iLig)
End If
Next
End With
End If
End If
'
Application.EnableEvents = True
Application.ScreenUpdating = True
'
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
iRowT = Target.Row
Target = UCase(Target)
'
If Not Intersect(Target, Range("E:E")) Is Nothing Then
If UCase(Target) = "DIAC LOC" Or UCase(Target) = "REPRISE" Then Range("L" & iRowT) = "AFFECTATION"
End If
'
If Not Intersect(Target, Range("D:D")) Is Nothing Then
Range("A" & iRowT & ":I" & iRowT).Interior.Color = IIf(UCase(Target) = "CARGO", RGB(200, 215, 155), xlNone)
Range("L" & iRowT) = "AFFECTATION"
Call Contrats(iRowT)
End If
If Not Intersect(Target, Range("G:G")) Is Nothing Then Call Contrats(iRowT)
'
Application.EnableEvents = True
Application.ScreenUpdating = True
'
End Sub
Public Sub Contrats(ByVal iRow As Integer)
'
Select Case Cells(iRow, 7)
Case "EST"
Cells(iRow, 7).Interior.Color = RGB(255, 190, 0)
Case "NORD"
Cells(iRow, 7).Interior.Color = RGB(150, 180, 215)
Case "RILLIEUX"
Cells(iRow, 7).Interior.Color = RGB(240, 190, 190)
Case Else
Cells(iRow, 7).Interior.Color = xlNone
End Select
'
End SubDans AFFECTATION
Tu colles directement les valeurs renvoyées par ton chef en [M:M] à partir de la ligne correspondante : le transfert démarre immédiatement!
La macro date chaque ligne transférée en [N:N] ou [P:P] selon la feuille (à vérifier).
Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If Target.Count > 1 Then
If Target.Column = 13 Then
iRowS = Target.Row
iRowE = (Target.Rows.Count + iRowS) - 1
For x = iRowE To iRowS Step -1
If Cells(x, 13) <> "" Then
sData = IIf(CStr(Cells(x, 13)) = "VOM" Or CStr(Cells(x, 13)) = "SOCCO", CStr(Cells(x, 13)), "VO " & CStr(Cells(x, 13)))
With Worksheets(sData)
iRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & x & ":L" & x).Copy Destination:=.Range("A" & iRow & ":L" & iRow)
.Range(IIf(Left(sData, 3) = "VO ", "N", "P") & iRow).Value = Date
Rows(x).Delete shift:=xlUp
End With
End If
Next
End If
End If
Worksheets("STOCK").Activate
'
Application.EnableEvents = True
Application.ScreenUpdating = True
'
End SubIl y a encore beaucoup de choses à dire mais commençons par cela.
J'attends tes réactions, précisions, corrections, suggestions...
A+
Wouah, quelle rapidité !!
Alors concernant la feuille STOCK
Le transfert en double clic fonctionne bien (j'ai remplacé CVVO par AFFECTATION dans la formule car j'avais un plantage), par contre, les lignes coupées sont collées en double en écrasant la ligne de données d'en-têtes dans la feuille AFFECTATION
Si je fais plusieurs affectations à intervalle régulier, les dernières lignes transférées écrasent les premières dans la feuille AFFECTATION, elles ne s'enregistrent pas à la suite.
Concernant le transfert depuis AFFECTATION vers les autres feuilles.
Ca fonctionne qu'une seule fois. Ca coupe le tableau de A => M en enlevant la mise en forme des cellules. Du coup pour le transfert suivant ca ne fonctionne plus.
Concernant le VO, il faut bien faire une distinction entre les 4 établissements (SUD, EST, NORD et RILLIEUX) lors de l'affectation.
Lors que je fais l'affectation dans la colonne MM, la cellule retourne automatiquement sur la feuille STOCK, bizarre.
A+
Salut Nico,
si tu as changé 'CVVO' par 'AFFECTATION' sans rien changer au code, forcément!
La liste se fabrique dans 'CVVO' en effaçant d'abord tout ce qui s'y trouve (ça, d'accord, ça se discute!) PUIS, après être triée, elle est transférée vers 'AFFECTATION' où, perso, après plusieurs transferts successifs, je ne vois aucun problème (ni double, ni écrasement)!
Je ne comprends pas ce que tu veux dire au deuxième point!
En m'appuyant sur ton code en Module2, j'efface les lignes au fur et à mesure qu'elles sont dispatchées.
Normal qu'il n'y ait plus rien, raison pour laquelle, je retourne sur 'STOCK' où se passe le plus clair de ton boulot.
Worksheets("STOCK").ActivateBref, y'a du boulot!
A+
Salut Nico,
un gros problème pour la vitesse, ce sont les transferts de couleur!!!
De 'STOCK' vers 'AFFECTATION' ou autres, puisque tu me dis que tu traites une trentaine de dossiers/jour et si ils sont transférés chaque jour, ça ne pose pas de souci.
Mais, par exemple, dans 'VO SUD' (et sans savoir comment tu fonctionnes!) pour parcourir tes milliers de lignes, les copier avec leurs couleurs et les éliminer, il faut une vingtaine de secondes pour +- 2000 lignes... 0.5 secondes avec un tableau!
Tu me diras : 20 secondes! Même pas le temps de boire son café!
Encore une fois, sans savoir comment tu fonctionnes! Faudrait-il mettre des compteurs avec le nombre de dossiers divers?
Les couleurs sont-elles indispensables ailleurs qu'en 'STOCK' ou, pour le dire autrement, à partir de quel "dispatching" les couleurs deviennent-elles inutiles?
8)
A+
Merci pour les informations,
Concernant CVVO, si je ne faisait pas le changement, j'avais un plantage direct de la fonction avec un message d'erreur qui ressortait sur VBA, le fichier étant au boulot, j'essaierai de te faire des imprimes écran demain afin que tu puisses voir des défauts relevés. Après je fais peux-être des erreurs de saisie. Ce que je ne comprends pas dans CVVO, c'est que je n'ai pas de feuille CVVO
Le deuxième point concernant les cellules de A => M?
En faite ça supprime les case de A => M en effaçant aussi la mise en forme des case (quadrillage, texte centré, etc...) mais c'est peux-être lié au fait qui j'ai changé CVVO.
Sur ma formule, normalement, je coupe la ligne complète et je la colle dans le tableau voulu. Ce qui fait que je garde la mise en forme des lignes suivantes qui "remonte" dans le tableau.
Alors que j'ai l'impression que sur ta formule ca coupe les cellules de A => M que tu colles ensuite dans le tableau, du coup ça fait perdre l'apparence et la forme des cellules a l'endroit coupé. Après c'est aussi peux être pour ça que ma formule est trop lourde !!
Concernant les couleurs, je ne pensais pas que cela pouvait ralentir le calcul.
A+
Bonsoir Nico,
que je suis distrait...
J'ai complètement zappé de te dire de créer une nouvelle feuille dans ta copie de travail : 'CVVO', terme que tu utilises dans un de tes posts pour désigner ton chef.
L'idée :
- créer ta liste triée pour le chef et encoder cette liste triée dans 'AFFECTATION' ;
- quand la réponse du chef revient, il suffit de coller les réponses (et uniquement les réponses) dans 'AFFECTATION' en [M:M], en regard de la liste, réponses qui théoriquement doivent correspondre pile-poil, ligne pour ligne.
Donc, crée la feuille 'CVVO' et recommence le test!
Je regarde à nouveau demain.
A+
Salut Curulis
J'ai un message d'erreur lorsque je veux transferer les véhicules après avoir collé les affectations du CVVO. Erreur d'exécution 9.
Je t'ai fait des captures en PJ.
Est-ce que cela vient du fait que le CVVO n'a pas répondu à toute les affectations ?
A+
Salut Nico,
théoriquement, le coup était prévu...
If Cells(x, 13) <> "" ThenIl devait traîner dans cette cellule un caractère non-imprimable quelconque en provenance du chef... Faudra prévoir...
A part cette erreur (mets n'importe quoi dans ce vide pour essayer), question vitesse malgré les COPY, qu'est-ce que ça raconte?
Pour te garder tes couleurs, je vais essayer autre chose. Dis-toi que je suis toujours en mode test pour trouver la meilleure solution de transfert. Pour les détails pratico-pratiques (et je pense à plein de trucs pour te faciliter la vie), on verra après!
A+
En mettant VOM dans les cases vide (écrit manuellement) rien de ne se passe mis a part le fait que je retourne sur la feuille STOCK.
Merci en tout cas pour tous ces efforts
Salut Nico,
Résumons :
- tu veux garder les couleurs dans 'STOCK' et 'AFFECTATION' ,
- par contre, ailleurs, on peut s'en passer!
- les pertes de temps sont dues aux COPY et aussi, je l'ai remarqué, au temps mis pour l'effacement des lignes transférés malgré l'utilisation de SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Comprends pas!
On pourrait prévoir une macro spécial effacement qui balayerait toutes les feuilles pendant un temps mort de ta journée (midi, fin de journée..)
- Parlons listes de validation : sont-elles toutes nécessaires partout où elles sont ou y sont-elles surtout du fait des COPY?
Il faudrait un relevé exhaustif des nécessités de ces listes, leurs options, colonnes et feuilles.
Je suppose que ça joue dans le poids de ton fichier.
Par exemple, dans 'VO SUD', ta macro ne transfère que vers 'VOM' ou 'EST' : les autres options des listes de validations sont-elles nécessaires?
Des affectations automatiques, comme AFFECTATION dans 'STOCK' pour tes véhicules (CARGO...) peuvent-elle se reproduire dans d'autres cas?
Peut-on réduire ces options selon certaines règles?
J'ai l'habitude de créer mes listes de validation lors d'un clic-gauche en limitant les options selon les circonstances et de les éliminer après usage.
Si tu as cette patience, on peut arriver à un résultat étonnant avec un Excel de plus en plus rapide!
A+
Salut Curilis,
Pour les couleurs c'est tout a fait ça. Si le fait de les enlever pour la liste permet de gagner en vitesse sur le fichier, je préfère supprimer ces couleurs.
Concernant les listes d'affectations:
Depuis STOCK => AFFECTATION + TRANSPORT
Par contre j'ai besoin de notifier sur mon fichier les dossiers CARGO qui sont en attente de SOLDE, ou les dossiers qui sont en attente (DOSSIER) qu'il faut que j'inscrive dans colonne L. Mais ces termes ce sont pas soumis à une macro.
Depuis AFFECTATION => VOM + SOCCO + SUD + NORD + EST + RILLIEUX
C'est le plus gros travail des macros afin de répartir suivant les bonnes feuilles. Il faut tenir compte du fait que le CVVO n'affecte pas forcement 100% des dossiers transmis. Il faut donc prévoir le fait que des cellules ne soient pas remplies. Si possible, ne pas intégrer de transfert automatique lors du remplissage de la colonne M, mais une validation du transfert par double clic serait génial
Depuis VOM => TRANSPORT
J'avais créé une condition en rapport avec une date afin que l'inscription se note toute seule en feuille TRANSPORT. En effet, la date lors de la saisie est parfois effectuée avec un décalage de la date réelle (congé, absence, etc...) il faut donc que j'inscrive la vrai date manuellement (pas automatique). On peut réfléchir à un transfert par mot (TRANSPORT) comme pour la feuille STOCK et que je rentre manuellement la date de sortie du véhicule.
Depuis SOCCO => TRANSPORT
Idem a VOM
Concernant les 4 sites SUD, NORD, EST et RILLIEUX,
Nous pouvons supprimer tout transfert sauf pour SUD pour lequel je voudrais garder le transfert vers VOM.
Concernant des affectations automatiques, cela va être très difficile, car c'est un choix qui ne m'appartient pas et dont le CVVO a ces propres critères commerciaux (nombre de véhicules en stock, véhicule identique déjà en stock, véhicule a fort potentiel de vente, véhicule recherché, etc...). Malheureusement, je ne peux rien automatiser
Par contre je ne sais pas si cela peux simplifier le fonctionnement du fichier à termes, mais j'avais penser faire 2 feuilles de stock
STOCK INT, avec les véhicules m'appartenant (DIAC LOC, REPRISE et CARGO) => AFFECTATION => etc....
STOCK EXT, avec les véhicules ne m'appartenant pas (ALD, ARVAL, RRG, etc...) => TRANSPORT
Est-ce que cela simplifierai la programmation ?
A+
Salut Nico,
...pas pu faire grand'chose ces derniers jours mais la réflexion continue!
A+
Coucou CVRVLISQVEST,
Tu a écrit :... mais la réflexion continue !
surtout, ne te brûle pas les neurones avec la flamme olympique de ton avatar !!!
allez, j'te laisse à ta séance de cogitation monologuistique de brainstorming !!!
j'me souviens d'un film américain où le héros avait réussi à encercler l'ennemi à lui tout seul !
fortiche, le gars, hein ? ça d'vait vraiment être un super GI !
j'crois qu'c'était un film avec Clint Eastwood ; ou peut-être avec Steve McQueen ?
Cordialement
Salut dhany,
je pense plutôt à un film de guerre, genre Platoon ou un truc du genre de l'époque où un soldat saute sur une mine d'où la réplique :
- "Ce petit malin a réussi à nous encercler à lui tout seul!"
Je te rassure, je n'ai pas l'intention d'y laisser mes neurones!
Mon avatar est en fait le logo d'un jeu chesslike que j'ai mis au point ces dernières années.
A+
Pour ton avatar, j'en reviens pas !!! avec son style, ses 2 aigles, et surtout ses 3 lettres « V » pour « U »,
j'étais sûr qu'c'était un truc de la conquête romaine du temps de Jules César ! « veni, vedi, vici » :
« je suis venu, j'ai vu, j'ai vaincu » ; nul doute que cette devise te servira à battre à plate couture
Maxime Vachier-Lagrave, le Français qui a récemment battu le Norvégien Magnus Carlsen !
(mais si tu veux battre Jolly Jumper aux échecs, il te faudra la potion magique du druide Panoramix)
Bravo et bonne chance pour ton jeu chesslike !!!
Salut Nico,
au diable l'avarice, je consomme des tableaux comme jamais mais la vitesse est à ce prix!
Le code ci-dessous est à coller et tester dans ton fichier-copie dans le module de la feuille 'VO SUD'.
Pour les besoins de la cause, j'ai recopié les lignes existantes de la feuille jusqu'à 10.000 lignes!
Résultat : 2,7 secondes pour filtrer, répartir, actualiser 'VO SUD'.
Démarrage de la macro par un double-clic en [L:L].
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tDataO, tDataN(), tDataVOM(), tDataEST()
'
Cancel = True
ReDim tDataEST(17, 1)
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If Not Intersect(Target, Range("L:L")) Is Nothing Then
iRow = Range("A" & Rows.Count).End(xlUp).Row
tDataO = Range("A2:Q" & iRow).Value
For x = 1 To UBound(tDataO, 1)
If tDataO(x, 13) <> "" Then
Select Case tDataO(x, 13)
Case "VOM"
iIdxVOM = iIdxVOM + 1
ReDim Preserve tDataVOM(17, iIdxVOM)
For z = 1 To 17
tDataVOM(z - 1, iIdxVOM - 1) = tDataO(x, z)
Next
Case "EST"
iIdxEST = iIdxEST + 1
ReDim Preserve tDataEST(17, iIdxEST)
For z = 1 To 17
tDataEST(z - 1, iIdxEST - 1) = tDataO(x, z)
Next
Case Else
iIdxNEW = iIdxNEW + 1
ReDim Preserve tDataN(17, iIdxNEW)
For z = 1 To 17
tDataN(z - 1, iIdxNEW - 1) = tDataO(x, z)
Next
End Select
End If
Next
For x = 1 To 2
sData = IIf(x = 1, "VOM", "VO EST")
iRowT = Worksheets(sData).Range("A" & Rows.Count).End(xlUp).Row + 1
Worksheets(sData).Range("A" & iRowT).Resize(IIf(x = 1, UBound(tDataVOM, 2), UBound(tDataEST, 2)), 17) = WorksheetFunction.Transpose(IIf(x = 1, tDataVOM, tDataEST))
Next
Range("A2:Q" & iRow + 1).ClearContents
Range("A2").Resize(UBound(tDataN, 2), 17) = WorksheetFunction.Transpose(tDataN)
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End SubOn va maintenant commencer à optimiser le reste. J'y reviendrai plus tard...
A+
Ave centurion CVRVLISQVEST,
Tu a écrit :je consomme des tableaux comme jamais... à ce prix !
As-tu pensé à exposer tes œuvres au musée du Louvres ?
Fini, la légion romaine ! même Jules César est parti se reposer auprès de sa chère reine Cléopâtre !
Ça ne lui a pas trop réussi de se reposer auprès de sa belle reine!
Petite question : comment crée-t-on une URL pour une image?
Je t'enverrais bien une photo de ce jeu qui semble t'intriguer!
Ave!
CVRVLISQVEST a écrit :Ça ne lui a pas trop réussi de se reposer auprès de sa belle reine !
Tu penses à quoi, au juste ? au fait qu'elle était capricieuse, cassait la vaisselle par terre quand elle était en colère,
avait « un très mauvais caracatère, mais quel nez ! » (dixit Panoramix) ; ou qu'elle a donné un fils à César, nommé
Brutus, qui l'aurait assassiné ? en tout cas, moi, je pensais à son repos avec Cléopâtre après qu'Astérix et Obélix
aient réussi toutes les épreuves dans la BD « Les 12 travaux d'Astérix » ; JC est habillé en jardinier, en compagnie
de la superbe Cléopâtre (qui est souriante et de très bonne humeur, pour changer !).
J'enregistre mon image .jpg sur un dossier de mon disque dur ; par exemple dans "Mes documents" ;
puis sous la fenêtre d'édition du message, je fais comme pour joindre un fichier Excel : clic sur le
bouton gris « Choisissez un fichier » ; là, sélectionner l'image .jpg ; clic sur bouton « Ouvrir » et enfin
clic sur le bouton vert « Ajouter le fichier » ; faire une vérif avec le bouton « Aperçu » ; et oui, ça me
plairait bien de voir ton jeu chesslike (même si j'connais à peine les règles du jeu d'échecs et que de
toute façon, j'préfère Excel et son VBA).
Ci-dessous, image de la BD gauloise :
Euh... Brutus n'était pas le fils de César et Cléopâtre
Ptolémée XV, dit Césarion, oui... ce qui ne lui a pas réussi beaucoup plus, d'ailleurs!
A+