Optimisation code VBA

Bonjour,

J'ai tenté de créer un code VBA qui effectue une action à la place de l'opérateur. Mais ce code demande beaucoup de ressource à l’ordinateur et met un temps certain à s'exécuter (voire fait crash Excel).

Est-il possible, selon vous de l'optimiser ?

Le code :

Sub Clearcontent()

Dim cell As Range
Dim celldate As Range
For Each cell In Range("F2:F8470")
If cell.Interior.ColorIndex <> xlColorIndexNone Then cell.ClearContents 'Efface toutes les cellules qui ne sont pas de couleur "vide" dans la colonne F
Next
For Each celldate In Range("C2:C8470")
If celldate.Interior.ColorIndex <> xlColorIndexNone Then celldate.ClearContents 'Efface toutes les cellules qui ne sont pas de couleur "vide" dans la colonne C
Next
End Sub

Bonjour YouniCornn,

En commençant par ajouter ces lignes de code au début:

Application.ScreenUpdating = False
application.Calculation = xlCalculationManual

Et à la fin de la procédure :

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Est-ce que le temps d'exécution est plus intéressant ?

Slts,

bonjour,

il faut créer un boucle pour rassembler ces cellules et après vider ces cellules

Sub Clearcontent()

     Dim UN    As Range
     Set c = Range("C2:C8470,F2:F8470")     'vos 2 colonnes
     Set UN = Range("A1")     'une cellule "DUMMY" hors la plage c

     t = Timer

     For Each cell In c.Cells
          If cell.Interior.ColorIndex <> xlColorIndexNone Then Set UN = Union(UN, cell)     'rassembler toutes ces cellules
     Next

     If UN.Cells.Count > 1 Then     'il y a des cellules ajouté
          Set UN = Intersect(UN, c)     'eliminer la première cellule hors c
          UN.ClearContents     'Efface toutes les cellules qui ne sont pas de couleur "vide" dans la colonne C
     End If

     MsgBox "temps d'exécution " & Format(Timer - t, "0.0\s")
End Sub

Et bonjour !

Tout d'abord merci pour ta réponse.

J'avais déjà vu ce code quelque part, mais ne comprenant pas sa fonction je l'ai laissé de coté...

Donc j'ai mis :

Sub Clearcontent()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim cell As Range
Dim celldate As Range
For Each cell In Range("F2:F8470")
If cell.Interior.ColorIndex <> xlColorIndexNone Then cell.ClearContents 'Efface toutes les cellule de couleur dans la colonne F
Next
For Each celldate In Range("C2:C8470")
If celldate.Interior.ColorIndex <> xlColorIndexNone Then celldate.ClearContents 'Efface toutes les cellules de couleur dans la colonne C

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Next
End Sub

... et cela met à peu près le même temps pour ce calculer. Avec moins de sauts à l'écran tout de même, donc plus agréable visuellement.

Est-ce que tester les cellules des deux colonnes en même temps nous ferait gagner du temps à l’exécution du code ? Sinon j n'ai pas d'autre idée :)

bonjour,

il faut créer un boucle pour rassembler ces cellules et après vider ces cellules

Sub Clearcontent()

Dim UN As Range

Set c = Range("C2:C8470,F2:F8470") 'vos 2 colonnes

Set UN = Range("A1") 'une cellule "DUMMY" hors la plage c

t = Timer

For Each cell In c.Cells

If cell.Interior.ColorIndex <> xlColorIndexNone Then Set UN = Union(UN, cell) 'rassembler toutes ces cellules

Next

If UN.Cells.Count > 1 Then 'il y a des cellules ajouté

Set UN = Intersect(UN, c) 'eliminer la première cellule hors c

UN.ClearContents 'Efface toutes les cellules qui ne sont pas de couleur "vide" dans la colonne C

End If

MsgBox "temps d'exécution " & Format(Timer - t, "0.0\s")

End Sub

J'ai testé cette version : résultat plus rapide mais le code ne s’exécute que sur les cellules visible. Si une catégorie (dans le segment à droite) est sélectionné tout ne sera pas effacé.

En plus de cela, la fenêtre Excel se fige un court instant (comme si Excel était en train de crash...).

Tout ceci est très prometteur, je vous joint le fichier pour que vous vous rendiez compte. Les deux macro sont enregistré en Clearcontents (pour la boucle) et Clearcontentes_old pour la 1ere proposition.

Ne sachant plus si le lien sera suppr automatiquement, merci de remplacer "[XX]" par "cjoint"

Le fichier : https://[XX].com/c/LHigOi7qlyv

re,

a mon avis, cette macro fonctionne pour toutes les cellules, même cachées, avec des couleurs non-conditionels

Je n'ai pas d'accès (à cause de mon publicateur ???)

hummm, quelque chose d'étrange, je n'avais pas copier ton code en entier...

Quoiqu'il en soit cela fonctionne parfaitement 27.2s pour tout effacer.

Il semblerai que ce soit une réussite ^^'

Bravo à tous (je clôture le sujet dans 2 jours une fois qu'il aura passé les tests d'application.

Merciiiiiiii !

re,

Quoi ??? 27 secondes, c'est trop, dans ce boucle on ne rassemble que les cellules colorés et non-vide.

PS. le 2ième chiffre après la virgule n'est pas très précis/fiable

Sub Clearcontent()

     Dim UN    As Range
     Set c = Range("C2:C8470,F2:F8470")     'vos 2 colonnes
     Set UN = Range("A1")     'une cellule "DUMMY" hors la plage c

     t = Timer 'start chronomètre

     For Each cell In c.Cells
          If cell.Interior.ColorIndex <> xlColorIndexNone & Len(cell.Value) > 0 Then Set UN = Union(UN, cell)     'rassembler toutes ces cellules avec un couleur et un contenu
     Next

     t1 = Timer 'entre temps

     If UN.Cells.Count > 1 Then     'il y a des cellules ajouté
          Set UN = Intersect(UN, c)     'eliminer la première cellule hors c
          UN.ClearContents     'Efface toutes les cellules qui ne sont pas de couleur "vide" dans la colonne C
     End If

     MsgBox "temps d'exécution " & Format(Timer - t, "0.00\s") & vbLf & "donc " & Format(t1 - t, "0.00\s") & " pour rassemblage" & vbLf & " et " & Format(Timer - t1, "0.00\s") & " pour Clearcontents'" 
    msgbox  "la plage " & UN.Address

End Sub

Alors, déjà j'aime cette détermination de l'optimisation :D

Ensuite j'ai vais sans doute avoir besoin de votre aide pour un autre sujet, mais qui concerne le même fichier (zone d'impression dynamique, dois-je faire un nouveau sujet ?)

J'ai testé ton code et là, rien ne s'efface, j'ai bien les message qui s'affiche mais je n'y comprend pas grand chose :/

" Temps d'éxécution 0.18s
donc 0.18s pour rassembllage
et 0.00s pour Clearcontents' "

puis

" la plage $A$1 "

Voici un nouveau lien (je pense que le 1er je l'avais mis en "privé"). Remplacer "[XX]" par "cjoint".

Lien : https://[XX].com/c/LHiiUOlXdkv

re,

en voyant votre fichier, c'est même plus facile, vous voulez vider toutes les cellules sauf celles avec une formule dedans, ce sont les .specialcells(xlconstants) !!

Et alors l'exécution est instantané

Sub Clearcontent_XLConstants()

     Dim UN    As Range
     t = Timer     'start chronomètre

     With Sheets("PN & GPN & AF").ListObjects("Tableau1").DataBodyRange 'votre tableau
          Set c = Union(.Columns(3), .Columns(5)).SpecialCells(xlConstants) '3ième et 5ième colonne, toutes les cellules sauf celles avec formule
          c.ClearContents
     End With

     MsgBox "temps d'exécution " & Format(Timer - t, "0.00\s")

End Sub

pour le zone d'impression, vous prenez toute la plage du tableau et puis vous utilisez les slicers, pour cacher tout ce que vous ne voulez pas emprimer.

Par exemple, vous voulez seulement les dates conso non-vides ! Alors dans le slicer "date conso" en haut vous selectionnez l'icon au milieu (multiple selection,voir image) et celui devient jaune (chez moi) et vous clicquez sur "vide" (=déselectionner) et il ne reste que des lignes avec des dates réel. De cette manière, il ne faut plus un zone dynamique.

le fichier que je vous retourne, il était >1.6MB, je l'ai essayé à diminuer en effacant des feuilles et de plages, maintenant il est vraiment petit, mais tout est presque disparu ! et il faut de nouveau protéger la feuille.

Raté ! Mais bien tenté ^^'

Effectivement je vous ai sans aucun doute mis sur la fausse piste avec les couleurs, et... je m'en excuse.

Je vais vous décrire précisément l'utilisation du fichier pour que vous puissiez comprendre ce que je souhaite.

Le fichier se compose de 4 onglets:

_ paramètre : pour les listes

_PN & GPN & AF : feuille de travail (saisie)

_ LANDRI : TCD qui permet d'avoir un aperçu des denrées alimentaire à sortir par jour (à imprimer pour le responsable logistique)

_ ZINA : TCD qui servira (une fois correctement configuré d'avoir un aperçu sur les commande à passer par le responsable des achats

Sur l'onglet de travail (PN& GPN & AF), nous retrouvons une multitude de ligne en répétition. Ceci est fait pour que l'opérateur qui s'assure de la saisie, n'ai pas à recopier des lignes précédentes (et se trompe par la même occasion) en duppliquant les données.

L'opérateur recoit plusieurs feuille de commande de la part d'un client :

Chaque feuille comprends les informations suivante :

_ Date

_ Besoin

L'opérateur doit donc saisir la date et le besoin de chaque prestation (en fonction du menue [ou groupe de commande], des variations sont visible [mais déjà configurées]).

Il y a énormément de ligne car il y a 13 "menus" différents et plusieurs composantes par menus. Il se trouve que j'ai déjà réduis de moitié le fichier, mais je ne pourrais pas aller en dessous d'environ 200 groupe de commande par menu.

J'ai besoin que dans chaque groupe de commande les cellules ne portant pas de formules soient effacées (actuellement le code proposé ne fonctionne pas, c'est la 6ème colonne qu'il faut effacer (j'ai donc modifié dans le code final). Mais sinon tout fonctionne nickel.

Pour terminer sur l'onglet de saisie, l'opérateur utilise le segment "Groupe de commande" afin de trier lors de la saisie, il ne fait rien d'autre sur cette feuille (ni impression, ni autre édition).

Pour ce qui est de la zone à imprimer il s'agit de l'onglet LANDRI (TCD qui évolue forcément en fonction des données saisies dans PN & GPN & AF).

Mon but est que sur l'impression (qui là est déjà configuré comme une zone dynamique) j'ai PAR JOUR et PAR MENU le nombre des élément à sortir du stock.

C'est déjà le cas.

MAIS, lors de l'impression, je ne souhaite pas avoir de saut de page à chaque changement de date (trop de gaspillage de papier), en revanche je souhaite que lorsque Excel décide d'imprimer un suite sur une autre page, il me répète l'étiquette de la date en haut.

Explication de l'exemple (impossible de joindre une autre image) :

10/08/2022

A-PN1

• Chips 56
• Eau 56
• Fruits 56
• Thon ...etc

A-PN2

• Chips 85
• Eau 85

_ _ _ _ _ _ _ _ _ __ _ _ _ _ _ _ __ POINTILLES BLEU (de saut de page, définit par le logiciel directement)

• Fruits 85
• Poulet 85

Ici je suis toujours sur la journée du 10, mais lorsque j'imprime, je n'ai pas de rappel de la date. Je sais que le rappel d'étiquettes est possible mais je ne sait pas ou trouver l'option ^^'.

J'espère que ce n'est pas trop long et as trop brouillon...

Avec un TCD, on ne fait pas se qu'on veut

Bon, regardez une fois, j'ai modifié le layout et la séparation est par jour, donc il cherche à imprimer une journée complète sur une page. Autrement, on peut aussi repeter le date sur chaque ligne ...

De nouveau un fichier reducé en taille.

Whoua c'est vraiment pas mal du tout ! Merci pour l'aide de tout le monde !

Merci à toi de ne pas avoir lâché avant que ce ne soit vraiment optimisé ^^'

A+

ps : j'ai un autre sujet en cours, ou je me répond à moi même car je trouve des solutions.
Si tu es intéressé voici le lien : https://forum.excel-pratique.com/excel/recherche-listes-avec-saisie-cout-de-revient-menus-174400

Par contre attends mon prochain message, j'ai bientôt terminé la construction du fichier avec les paramètre que je décris en haut du post.

aïe, j'ai parlé un peu vite.

Pour l'utilisation de la feuille de saisie, je souhaite protéger la feuille. L'opérateur doit pouvoir :

1. Saisir uniquement dans les cellules ne comportant pas de formule ou de texte

2. Utiliser le segment "filtre de groupe de commande"

3. Utiliser un bouton lié à la maccro xlContents

Sub Clearcontent_XLConstants()

     Dim UN    As Range
     t = Timer     'start chronomètre

     With Sheets("PN & GPN & AF").ListObjects("Tableau1").DataBodyRange 'votre tableau
          Set c = Union(.Columns(3), .Columns(6)).SpecialCells(xlConstants) '3ième et 6ième colonne, toutes les cellules sauf celles avec formule
          c.ClearContents
     End With

     MsgBox "temps d'exécution " & Format(Timer - t, "0.00\s")

End Sub

Pour rappel, le code de la maccro.

Merci pour votre future aide,