Une boucle pour 3 tests

[Risleure]

Bonjour à tous,

Voici un bout du code que j'utilise dans un module et qui fonctionne mais qui me semble un peu lourdingue.
Je souhaite qu'une ame charitable m'aide à le faire maigrir.

L'objectif de ce code est de parcourir une feuille "Listing" et d'y effectuer différents tests comme présence du mot Anonyme ou Libre dans la colonne B:B ou Abandon dans la colonne G:G et de changer la couleur de l'objet situé sur la feuille "Plan" et dont le nom est sur la feuille "Listing" en colonne A:A (Offset(0, -1) quand on est en B:B et Offset(0, -6) quand on est en G:G.

Pour le moment , dans la feuille "listing", je ne scrute que 300 lignes et dans la feuille "Plan", il n'y a que 350 shapes. Avec une babasse qui avance y' a pas de blem mais si je passe à 15000 lignes ...... Et je me contente actuellemnet de 3 tests mais je ne me limite pas.

Aujourd'hui, pour les trois tests, je réalise successivement trois boucles sur l'ensemble du tableau soit 900 scrutations (....... 3x300 pour ceux qui ont du mal à suivre !!!).
Je me dis que je gagnerai beacoup de temps si je réalisais les trois tests ou plus dans la même boucle.

NB : J'ai pompé et adapté le code à partir du fichier d'aide d'EXCEL (Méthode GASTON salut GORFAEL) mais j'ai pas tout compris (surtout If Not c Is Nothing ???????) mais il marche !!!!
Le problème est que quand je tente de le modifier pour faire un tout-en-un, ça plante furieusement.
Voici le code :

Sub XlForum()

NbEmplacements=300

'1-Trouve les sculptures libres et change la couleur en bleu
Sheets("Listing").Select
With Sheets("Listing").Range("B2:B" & NbEmplacements)
Set c = .Find("Libre", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address 'Arrete la boucle si vide
Do
Construction = "C" & Format(c.Offset(0, -1), "000")
Sheets("Plan").Shapes(Construction).Fill.ForeColor.SchemeColor = 4
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
'2-Trouve les sculptures anonymes et change la couleur en mauve
Sheets("Listing").Select
With Sheets("Listing").Range("B2:B" & NbEmplacements)
Set c = .Find("Anonyme", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address 'Arrete la boucle si vide
Do
Construction = "C" & Format(c.Offset(0, -1), "000")
Sheets("Plan").Shapes(Construction).Fill.ForeColor.SchemeColor = 6
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
'3-Trouve les sculptures en état d'abandon et change la couleur en jaune
Sheets("Listing").Select
With Sheets("Listing").Range("G2:G" & NbEmplacements)
Set c = .Find("Abandon", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address 'Arrete la boucle si vide
Do
Construction = "C" & Format(c.Offset(0, -6), "000")
Sheets("Plan").Shapes(Construction).Fill.ForeColor.SchemeColor = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

Merci à ceux qui ont eu le courage de lire jusque là.

 

[Gorfael]

Re : Une boucle pour 3 tests

Bonjour à tous,

NB : J'ai pompé et adapté le code à partir du fichier d'aide d'EXCEL (Méthode GASTON salut GORFAEL) mais j'ai pas tout compris (surtout If Not c Is Nothing ???????) mais il marche !!!!

Salut
J'ai juste jeté un cil parce que j'ai vu mon nom.
Je ne pense pas que tu puisses réellement aller plus vite : tu ne fais pas ta boucle sur 300 ligne, tu fais un équivalent de rechercher : donc tu sautes de réponse en réponse. Mais je ne suis pas un connaisseur de find
peut-être avec
Find("""Libre"" or ""Anonyme"" or ""Abandon""", LookIn:=xlValues))
Mais je n'ai pas testé

Par contre, Sheets("Listing").Select tu devrais pouvoir les virer

P'tite explication :
If Not c Is Nothing Then ici c est un objet Range
on sait dire qu'un objet (feuille, range) n'existe pas :
c Is Nothing => vrai si c n'existe pas (pour Excel), il n'est pas créé. Mais si tu le teste, et qu'il n'existe pas, Excel te retourne une erreur en te disant qu'il ne le trouve pas. Donc tu ne peux pas mettre une instruction du style :
c<>null ou c<>"", puisque c ne sera défini que si Excel trouve une réponse à Find.

À ma connaissance, il n'existe pas d'instruction du style Is Thing, donc on fait avec ce qu'on a
et c'est un peu con de faire une instruction
If c Is Nothing Then
else
instruction
endif
Donc, on se sert de l'instruction Not() qui est une instruction booléenne qui inverse la valeur :
Not(TRUE) = FALSE et évidemment Not(FALSE) = TRUE

Donc ton test signifie
si le contraire de c est rien est vrai alors
oui en plus clair
si c n'est pas rien alors

Pour le reste, il faut que je teste pour savoir ce qui se passe, mais d'après ce que je comprends pour la première boucle :

With Sheets("Listing").Range("B2:B" & NbEmplacements)
Pour éviter de le remettre à chaque find
Set c = .Find("Libre", LookIn:=xlValues)
c=cellule (range) qui contient "Libre" en valeur (.FindFirst par défaut)
If Not c Is Nothing Then
s'il y a une cellule qui contient "libre" on fait le reste, sinon on passe à la boucle suivante
firstAddress = c.Address 'Arrete la boucle si vide
On stocke l'adresse de la première cellule correspondante pour éviter un rebouclage continu
Do
Début de boucle
Construction = "C" & Format(c.Offset(0, -1), "000")
Construction = Cxxx avec xxx, nombre de 3 chiffres de la valeur de la colonne A
Sheets("Plan").Shapes(Construction).Fill.ForeColor .SchemeColor = 4
On colorie la forme du nom construction
Set c = .FindNext(c)
on recherche la cellule suivant correspondant à "Libre" dans la plage et on la stocke en c
Loop While Not c Is Nothing And c.Address <> firstAddress
On boucle tant qu'on trouve des correspondances ET que ces correspondances soit différente de la première adresse
End If
End With

A+

 

[Risleure]

Re : Une boucle pour 3 tests

Salut Tatiak, Salut Gorfael
Merci à vous deux pour les réponses. Je comprends mieux le "Not c is Nothing".
Je vais suivre vos conseils pour modifier le code.

A+