Rechercher une valeur, selectionner la cellule et mettre en forme
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.
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.
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