Compter cellules selon couleur, macro à optimiser
Résolu/Fermé
-NoeGo-
Messages postés
51
Date d'inscription
mercredi 28 décembre 2016
Statut
Membre
Dernière intervention
7 mai 2021
-
27 janv. 2017 à 15:24
-NoeGo- Messages postés 51 Date d'inscription mercredi 28 décembre 2016 Statut Membre Dernière intervention 7 mai 2021 - 3 févr. 2017 à 16:24
-NoeGo- Messages postés 51 Date d'inscription mercredi 28 décembre 2016 Statut Membre Dernière intervention 7 mai 2021 - 3 févr. 2017 à 16:24
A voir également:
- Compter cellules selon couleur, macro à optimiser
- Excel compter cellule couleur sans vba ✓ - Forum Excel
- Macro logiciel - Télécharger - Organisation
- Optimiser windows 10 - Guide
- Somme si couleur - Guide
- Iphone 14 couleur - Guide
4 réponses
michel_m
Messages postés
16593
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
7 mars 2023
3 291
Modifié par michel_m le 28/01/2017 à 09:03
Modifié par michel_m le 28/01/2017 à 09:03
Bonjour,
As tu essayé de parcourir ta plage par un objet dictionary ?
un principe:
A adapter bien sûr à ton contexte (tableau reste à base 0 malgré ton option base 1)
discussion déplacée dans le forum programmation VBA
Michel
As tu essayé de parcourir ta plage par un objet dictionary ?
un principe:
dim dico as object
set Dico=createobject("scripting.dictionary")
for each cellule in plage
Couleur=cellule.interior.color
If not dico.exists(couleur) Then dico.add couleur, ""
next
Tableau=dico.keys
A adapter bien sûr à ton contexte (tableau reste à base 0 malgré ton option base 1)
discussion déplacée dans le forum programmation VBA
Michel
michel_m
Messages postés
16593
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
7 mars 2023
3 291
1 févr. 2017 à 16:51
1 févr. 2017 à 16:51
déjà utilise
application.screenupdating=False
Les cellules fusionnées sont un véritable fléau en VBA à éviter au maximum
application.screenupdating=False
Les cellules fusionnées sont un véritable fléau en VBA à éviter au maximum
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
2 févr. 2017 à 07:53
2 févr. 2017 à 07:53
Bonjour NoeGo, Michel,
Pas certain que ScreenUpdating diminue le temps d'exécution dans ce cas précis.
Par contre, sans cellules fusionnées, on pourrait faire beaucoup plus rapide.
Plage ==> Var Tableau ==> Dictionary (ou Collection)
Autre conseil, placer Couleur.Interior.Color dans une variable en début de fonction.
Pas certain que ScreenUpdating diminue le temps d'exécution dans ce cas précis.
Par contre, sans cellules fusionnées, on pourrait faire beaucoup plus rapide.
Plage ==> Var Tableau ==> Dictionary (ou Collection)
Autre conseil, placer Couleur.Interior.Color dans une variable en début de fonction.
-NoeGo-
Messages postés
51
Date d'inscription
mercredi 28 décembre 2016
Statut
Membre
Dernière intervention
7 mai 2021
12
3 févr. 2017 à 16:24
3 févr. 2017 à 16:24
Bonjour à vous,
Merci beaucoup pour vos conseils.
Malheureusement, j'ai créé la macro pour un chef, et il veut absolument fusionner des cellules, donc je dois m'adapter...
Finalement, le temps d’exécution est tout à fait acceptable avec les aménagements que vous m'avez proposé.
Et surtout, j'ai l'impression que sur le réseau c'est plus rapide qu'en VPN de chez moi !
Encore merci,
-NoeGo-
Merci beaucoup pour vos conseils.
Malheureusement, j'ai créé la macro pour un chef, et il veut absolument fusionner des cellules, donc je dois m'adapter...
Finalement, le temps d’exécution est tout à fait acceptable avec les aménagements que vous m'avez proposé.
Et surtout, j'ai l'impression que sur le réseau c'est plus rapide qu'en VPN de chez moi !
Encore merci,
-NoeGo-
1 févr. 2017 à 16:26
Merci pour cette suggestion.
Je ne connaissais pas l'objet dictionary.
Malheureusement, au final le temps d’exécution ne change que peu.
Je ne suis pas sûr qu'on puisse faire beaucoup mieux...
Le nouveau code :
Option Explicit Function NbCellulesSelonCouleur(Plage As Range, Couleur As Range) As Long 'Compte le nombre de cellules d'une couleur donnée dans une plage donnée Application.Volatile 'Recalcule à chaque modification du fichier la valeur de la fonction Dim Cellule As Range Dim Dico As Object NbCellulesSelonCouleur = 0 Set Dico = CreateObject("scripting.dictionary") For Each Cellule In Plage If Cellule.MergeArea(1, 1).Address = Cellule.Address And Cellule.Interior.Color = Couleur.Interior.Color Then If Not Dico.exists(Cellule.Column) Then Dico.Add Cellule.Column, "" NbCellulesSelonCouleur = NbCellulesSelonCouleur + 1 End If End If Next Cellule End Function