HELP URGENT => Problème d'affectation couleur "colorIndex" de mes lignes

[cortadillo]

Bonjour les amis,

j'ai un big problème aujourd'hui, j'ai réalisé un petit tableau excel dont l'objectif est de mettre différent couleur de fond de cellule en fonction du numéro index.

j'ai en effet mis en place une colonne index qui me permet d'attribuer un groupe de couleur.

Problème n°1=> mon index est à 38 ce qui est supérieur au code colorIndex.

Problème n°2=> j'ai découvert un bug dans mon code puisque dans le groupe index n°22 j'ai différente couleur!! cf. ligne 960 du fichier joint. donc ce n'est pas bon.

Quelqu'un peut il me apporter assistance pour corriger mon code.

Encore merci.
ci-joint le fichier et la macro

Regarde la pièce jointe ClasseurTest.zip


Pour info voici le code vba:

Sub MFC_Couleur()


Application.ScreenUpdating = False


Set mondico = CreateObject("Scripting.Dictionary")
For Each Cel In Range("BF2:BF" & Range("BF65536").End(xlUp).Row)
If Not mondico.Exists(Cel.Value) Then mondico.Add Cel.Value, Cel.Value
Next

For Each Item In mondico.items
If Item <> "" Then

couleur = 35 + Item
Else
Item = 0
couleur = 0
Exit Sub
End If


Set c = Columns("BF").Find(Item, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
ld = c.Row: lf = ld - 1
Do
lf = lf + 1
Set c = Columns("BF").FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If

Range(Cells(ld, 1), Cells(lf, 9)).Interior.ColorIndex = couleur

lf = 0

Next

 

[Robert]

Re : HELP URGENT => Problème d'affectation couleur "colorIndex" de mes lignes

Bonjour Cortadillo, bonjour le forum,

je pense que tu as voulu alléger ton fichier original (muy cortadillo...) et du coup, le code ne peux plus fonctionner tel que c'est. Il manquait aussi un End Sub à la fin...
Ton code avec en rouge les erreurs :

Sub MFC_Couleur()
Application.ScreenUpdating = False
Sheets("Données Maitre MOE").Visible = True
Sheets("Données Maitre MOE").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Sort Key1:=Range("R2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Set mondico = CreateObject("Scripting.Dictionary")
For Each Cel In Range("BF2:BF" & Range("BF65536").End(xlUp).Row)
If Not mondico.Exists(Cel.Value) Then mondico.Add Cel.Value, Cel.Value
Next
For Each Item In mondico.items
If Item <> "" Then
couleur = 35 + Item
Else
Item = 0
couleur = 0
Exit Sub
End If

Set c = Columns("BF").Find(Item, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
ld = c.Row: lf = ld - 1
Do
lf = lf + 1
Set c = Columns("BF").FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If

Range(Cells(ld, 1), Cells(lf, 9)).Interior.ColorIndex = couleur
lf = 0
Next
End Sub

Propose-nous un exemple qui fonctionne, ça nous permettra de mieux comprendre ton problème et peut-être d'y trouver une solution...

 

[cortadillo]

Re : HELP URGENT => Problème d'affectation couleur "colorIndex" de mes lignes

Merci de ta réponse Robert, voici le nouveau fichier avec la macro corrigé.

Ce nouveau fichier vous permettra de comprendre les problèmes qui pour rappel sont les suivants:

Problème n°1=> mon index est à 38 ce qui est supérieur au code colorIndex.

Problème n°2=> j'ai découvert un bug dans mon code puisque dans le groupe index n°22 j'ai différente couleur!! cf. ligne 960 du fichier joint. donc ce n'est pas bon.


Merci bien.


Regarde la pièce jointe ClasseurTest.zip

le code vba est le suivant:

Sub MFC_Couleur()


Application.ScreenUpdating = False

Sheets("Données Maitre MOE").Visible = True
Sheets("Données Maitre MOE").Select

Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Set mondico = CreateObject("Scripting.Dictionary")
For Each Cel In Range("I2:i" & Range("I65536").End(xlUp).Row)
If Not mondico.Exists(Cel.Value) Then mondico.Add Cel.Value, Cel.Value
Next

For Each Item In mondico.items
If Item <> "" Then

couleur = 35 + Item
Else
Item = 0
couleur = 0
Exit Sub
End If


Set c = Columns("I").Find(Item, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
ld = c.Row: lf = ld - 1
Do
lf = lf + 1
Set c = Columns("i").FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
Range(Cells(ld, 1), Cells(lf, 9)).Interior.ColorIndex = couleur
End If


Range(Cells(ld, 1), Cells(lf, 9)).Interior.ColorIndex = couleur

lf = 0



Next

End Sub

 

[cortadillo]

Re : HELP URGENT => Problème d'affectation couleur "colorIndex" de mes lignes

personne pour m'aider???

 

[Robert]

Re : HELP URGENT => Problème d'affectation couleur "colorIndex" de mes lignes

Bonsoir Cortadillo, bonsoir le forum,

En utilisant la (valeur de l'item +35) Mod 56 on évite le bug ColorIndex = 57... Essaie comme ça :

Sub MFC_Couleur()
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim pl As Range 'éclare la variable pl (Plage)

Application.ScreenUpdating = False
Sheets("Données Maitre MOE").Visible = True
Sheets("Données Maitre MOE").Select
dl = Cells(Application.Rows.Count, 1).End(xlUp).Row
Range("A1:I" & dl).Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For Each cel In Range("I2:I" & dl)
    Set pl = Range(Cells(cel.Row, 1), Cells(cel.Row, 9))
    If cel <> "" Then
        pl.Interior.ColorIndex = (cel.Value + 35) Mod 56
        If cel.Value = 22 Then pl.Font.ColorIndex = 2
    End If
Next cel
Application.ScreenUpdating = True
End Sub