Repère cellules contigus
Bonjour,
Je dois apposer un fond de couleur différent pour des cellules contigus contenues dans un tableau
Exemple:
A1: TITRE COLONNE
A2=PYCUC2-A01
A3=PYCUC2-A02
A4=PYCUC2-A03
A5=PYCUC2-B04
A6=PYCUC2-B05
A7=PYCUC2-C01
A8=PYCUC2-D02
A9=PYCUC2-D03
Les cellules A2,A3,A4 sont d'une couleur bleu
Les cellules A5,A6 sont d'une couleur verte
Les cellules A8,A9 sont d'une couleur
REMARQUE: La cellule A7 n'a pas de couleur car pas de suite avec la cellule précédente ou suivante.
Je sais que cet exercice est difficile. Est-il possible de faire cela via des fonctions et/ou du vba et bien sur comment car je planche depuis plusieurs semaines.
EN vous remerciant par avance.
Bonjour,
comment est choisie la couleur ?
up...
Bonjour Nelson,
Les couleurs utilisées n'ont pas d'importances.
Le plus important est de trouver les suites selon les 3 dernières valeurs.
Remarque: le titre de la colonne est immuable.
Le faire avec MFC me semble délicat ! en plus du changement de couleur.
Donc, je vais passer en VBA ...
Sub colorer()
nbcol = 3 ' nombre de colonnes à colorier
Dim depuis As Range, jusque As Range
Set depuis = Cells(2, 1): Set jusque = Cells(2, nbcol)
With Cells.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
oldsuffixe = "": n = 0: couleur = 33
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row + 1
newsuffixe = Right(Cells(i, 1), 3)
If Left(newsuffixe, 1) = Left(oldsuffixe, 1) And Val(Right(newsuffixe, 2)) = Val(Right(oldsuffixe, 2)) + 1 Then
Set jusque = Cells(i, nbcol)
n = n + 1
Else
If n > 1 Then
Range(depuis, jusque).Interior.ColorIndex = couleur
couleur = IIf(couleur = 40, 33, couleur + 1) ' de index 33 à 40
End If
Set depuis = Cells(i, 1)
n = 1
End If
oldsuffixe = newsuffixe
Next
End SubC’est génial. Vous êtes super.
Un grand merci à vous.
Parfait !
Bonjour,
Je me permets de reprendre contact avec vous car vous connaissez bien mon sujet.
En effet, maintenant que j'ai grace à vous des codes couleur différents par séries qui se suivent, je desire maintenant pouvoir comptabiliser dans un nouvel onglet ces suites de couleurs tels que dans le fichier joint
EN vous remerciant par avance.
Voici, via TCD
Bonjour didier45
La réponse te convient-elle ?
Bonjour Steelson,
Malheureusement Non . J'ai dû mal exposer mon problème.
Voici un fichier excel qui je l'espère sera plus clair que mon précédent mail
En te remerciant par avance.
Bon courage
Bonjour Steelson,
Malheureusement non. J'ai du mal exprimer mon besoin.
Voici un nouveau fichier qui je l'espère t'apportera plus de clarté à ma demande.
EN te remerciant par avance.
ok
Mais en fait l'erreur vient du tout début ...même les couleurs étaient erronées.
Dommage de ne pas l'avoir signalé.
Je corrige.
Voici ma version actuelle, me dire si tu t'y retrouves
Bonjour Didier,
la nouvelle proposition te convient-elle ?
Rien a dire. Respect à toi Steelson. Merci beaucoup.
Peux tu me dire comment procéder pour arriver à ton niveau ?
Encore un sans fautes. C'est impressionnant. Je te félicite à nouveau.
J'ai une dernière question:
J'essaie de variabiliser un nom (nomTab) défini dans le gestionnaire de noms. Voici le code associé.
Dim i As Byte
Dim listeSalles As Variant
Dim nbSalles As Variant
Dim nomTableau As String
Dim nomGestNom As String
Dim nomTab As String
listeSalles = Array("C2", "C3", "C4", "C5", "C6", "UC1", "UC2", "UC4")
nbSalles = Array("B26", "C26", "D26", "E26", "F26", "G26", "H26", "I26")
For i = LBound(listeSalles) To UBound(listeSalles)
Sheets("RAPPORT").Select
Range(nbSalles(i)).Select
Selection.ShowDetail = True
ActiveSheet.Name = listeSalles(i)
nomTableau = Worksheets(ActiveSheet.Name).ListObjects(1).Name
ActiveSheet.ListObjects(nomTableau).Name = "Tab" & listeSalles(i)
nomTab = "Tab" & listeSalles(i)
ActiveWorkbook.Worksheets(ActiveSheet.Name).ListObjects(nomTab).Sort.SortFields. _
Clear
'**************************************************************************************************
'Probleme récupération du contenu de la variable nomTAB dans Range("& nomTab[Nom baie]&")
ActiveWorkbook.Worksheets(listeSalles(i)).ListObjects(nomTab).Sort.SortFields.Add Key _
:=Range(""" & nomTab[Nom baie] & """), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
'***************************************************************************************************
With ActiveWorkbook.Worksheets(listeSalles(i)).ListObjects(nomTab).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Next
End Sub
Le code qui ne fonctionne pas est le suivant:
ActiveWorkbook.Worksheets(listeSalles(i)).ListObjects(nomTab).Sort.SortFields.Add Key _
:=Range(""" & nomTab[Nom baie] & """), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
Je te joins en pièce jointe le code erreur résultant
