Rechercher une valeur, selectionner la cellule et mettre en forme

Le 02/07/2019 à 14:29

Bonjour à tous,

voilà deux semaines que j'ai commencé à me mettre à Excel - VBA..

J'ai réussi quelques petites macros mais là (malgré mes nombreuses recherches) je n'arrive pas à faire ce que je souhaite et/ou combiner les différentes fonctions entre elles.

Ce que je souhaite faire :

Je souhaite remplir en vert, en rouge ou en orange des cases qui contiennent un nom spécifique situé sur une feuille nommée "SYNOPTIQUE".

Pour choisir la couleur il y a un tableau qui determine les conditions (le tableau est situé dans une feuille nommée "DBF BPE".

Si en L13 c'est "POSEE" et en N13 c'est "OUI" (feuille "DBF BPE") alors la macro cherche la valeur en C13 de cette feuille sur la feuille"SYNOPTIQUE" et la colorie en bleu

Si en L13 c'est "POSEE" et en N13 c'est "NON" (feuille "DBF BPE") alors la macro cherche la valeur en C13 de cette feuille sur la feuille"SYNOPTIQUE" et la colorie en orange

Si en L13 c'est "EN PROJET" (feuille "DBF BPE") alors la macro cherche la valeur en C13 de cette feuille sur la feuille"SYNOPTIQUE" et la colorie en rouge

Et ainsi de suite sur 213 lignes consécutives.

J'ai donc fait une boucle avec des If, ElseIf, Find etc mais je ne maitrise pas trop cette dernière et ça bug

Voici le code en entier:

Sub AVANCEMENT_CHANTIER()

Dim code As String

Dim code1 As String

Dim code2 As String

Dim count As Integer

count = 0

For j = 0 To 213

Sheets("DBF BPE").Select

code = Range("C" & 13 + j)

code1 = Range("L" & 13 + j)

code2 = Range("N" & 13 + j)

Sheets("SYNOPTIQUE").Select

If code1 = "POSEE" And code2 = "OUI" Then

Cell.Find(code, LookIn:=xlValues, LookAt:=xlWhole).Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.Color = 5296274

.TintAndShade = 0

.PatternTintAndShade = 0

End With

With Selection.Font

.ColorIndex = xlAutomatic

.TintAndShade = 0

End With

ElseIf code1 = "POSEE" And code2 = "NON" Then

Cell.Find(code, LookIn:=xlValues, LookAt:=xlWhole).Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.Color = 49407

.TintAndShade = 0

.PatternTintAndShade = 0

End With

With Selection.Font

.ColorIndex = xlAutomatic

.TintAndShade = 0

End With

ElseIf code1 = "EN PROJET" Then

Cell.Find(code, LookIn:=xlValues, LookAt:=xlWhole).Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.Color = 192

.TintAndShade = 0

.PatternTintAndShade = 0

End With

With Selection.Font

.ColorIndex = xlAutomatic

.TintAndShade = 0

End With

End If

Next

End Sub

Si quelqu'un peu m'apporter ses lumières je suis preneur.

Un grand merci par avance.

Ulquiora.

Le 02/07/2019 à 14:54

Re,

alors après avoir publié j'ai vu un autre post qui y ressemblai (désolé je ne l'avais pas trouvé avant)

j'ai rajouté des s à "Cell" avant find dans le code et j'ai remplacé "Select" par "Activate";

Cela fonctionne pas trop mal mais la macro bug encore à ce niveau :

ElseIf code = "EN PROJET" Then

Cells.Find(code1, LookIn:=xlValues, LookAt:=xlWhole).Activate

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.Color = 192

.TintAndShade = 0

.PatternTintAndShade = 0

Cela bug au niveau de la condition "EN PROJET" . Est ce que c'est parce que c'est la valeur qui est première ligne de recherche en L13? ou parce que c'est la dernière condition ElseIF et qu'il doit forcément y avoir un Else à la fin? ou autre?

Merci pour vos réponses.

Ulquiora.

Le 11/07/2019 à 16:24

Bonjour,

je vois que mon post n'a pas fait fureur mais pour ceux que cela peut aider j'ai trouvé la solution.

Bien sur la solution est bien spécifique à mon fichier mais on ne sait jamais.

En fait cela venait du nombre de boucles effectuées. J'arrivais donc une cellule trop bas (sur une valeur non contenue dans ma feuille SYNO) d'où le bug. Bête mais gênant. A faire attention lorsque l'on utilise la fonction find en combiné.

Private Sub AVANCEMENT_CHANTIER_Click()

Dim code As String

Dim code1 As String

Dim code2 As String

Dim code3 As String

Dim code10 As String

Dim code11 As String

Dim code12 As String

Dim count As Integer

count = 0

For j = 0 To 204

code = Sheets("DBF BPE").Range("C" & 649 + j).Value

code1 = Sheets("DBF BPE").Range("L" & 649 + j).Value

code2 = Sheets("DBF BPE").Range("N" & 649 + j).Value

code3 = Sheets("DBF BPE").Range("AC" & 649 + j).Value

Sheets("SYNOPTIQUE").Select

If code3 Like "*BLOCAGE*" Then

Cells.Find(code, LookIn:=xlValues, LookAt:=xlWhole).Activate

With ActiveCell.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = 1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

With ActiveCell.Font

.ColorIndex = 2

.TintAndShade = 0

End With

ElseIf code1 = "POSEE" And code2 = "OUI" Then

Cells.Find(code, LookIn:=xlValues, LookAt:=xlWhole).Activate

With ActiveCell.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = 28

.TintAndShade = 0

.PatternTintAndShade = 0

End With

With ActiveCell.Font

.ColorIndex = xlAutomatic

.TintAndShade = 0

End With

ElseIf code1 = "POSEE" And code2 = "NON" Then

Cells.Find(code, LookIn:=xlValues, LookAt:=xlWhole).Activate

With ActiveCell.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = 45

.TintAndShade = 0

.PatternTintAndShade = 0

End With

With ActiveCell.Font

.ColorIndex = xlAutomatic

.TintAndShade = 0

End With

ElseIf code1 = "EN PROJET" Then

Cells.Find(code, LookIn:=xlValues, LookAt:=xlWhole).Activate

With ActiveCell.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = 3

.TintAndShade = 0

.PatternTintAndShade = 0

End With

With ActiveCell.Font

.ColorIndex = xlAutomatic

.TintAndShade = 0

End With

End If

Next

count = 0

For j = 0 To 224

code10 = Sheets("DBF CB").Range("C" & 710 + j).Value

code11 = Sheets("DBF CB").Range("T" & 710 + j).Value

code12 = Sheets("DBF CB").Range("Z" & 710 + j).Value

Sheets("SYNOPTIQUE").Select

If code12 Like "*BLOCAGE*" Then

Cells.Find(code10, LookIn:=xlValues, LookAt:=xlWhole).Activate

With ActiveCell.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = 1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

With ActiveCell.Font

.ColorIndex = 2

.TintAndShade = 0

End With

ElseIf code11 = "POSEE" Then

Cells.Find(code10, LookIn:=xlValues, LookAt:=xlWhole).Activate

With ActiveCell.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = 4

.TintAndShade = 0

.PatternTintAndShade = 0

End With

With ActiveCell.Font

.ColorIndex = xlAutomatic

.TintAndShade = 0

End With

ElseIf code11 = "EN PROJET" Then

Cells.Find(code10, LookIn:=xlValues, LookAt:=xlWhole).Activate

With ActiveCell.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ColorIndex = 3

.TintAndShade = 0

.PatternTintAndShade = 0

End With

With ActiveCell.Font

.ColorIndex = xlAutomatic

.TintAndShade = 0

End With

End If

Next

count = 0

Range("A1").Select

End Sub

Cordialement.

Ulquiorra

Rechercher des sujets similaires à "rechercher valeur selectionner mettre forme"