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à.
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à.