VBA pour rechercher une valeur et mettre en couleur

Bonsoir / Bonjour,

J'ai un tableau comprenant 12 feuilles correspondant aux 12 mois de l'année et nommé par les trois première lettre en français excepté JUIN et JUIL.

A chaque fois qu'un utilisateur rentre une donnée elle est automatiquement incrémenté dans les cellules de C7 à AG122 dans la ou les feuille(s) correspondant au(x) mois.

De les colonnes de C à AG, en ligne 9 puis toutes les 4 lignes jusqu'à la ligne 121, il y a trois possibilité de valeur : soit vide "" ; soit "CONFIRME" ; soit "OPTION".

J'aimerais qu'a chaque fois qu'un utilisateur rentre une donnée, la macro vérifie la valeur de la cellule M3 de la feuille Data qui est le mois correspondant à la dernière donnée rentré. Soit 1 = Janvier ; 2 = février ...

Puis en fonction du mois rechercher la ou les valeur(s) "CONFIRME" et colorier la ou les cellule(s) en vert ainsi que les deux cellules du dessus et 1 en dessous.

Même principe pour "OPTION" mais en rouge.

De plus il faudrait que la macro vérifie la valeur de la cellule N3 de la feuille Data et si celle ci est différente de la cellule M3 de la même feuille alors recommencer l'opération dans le mois correspondant à la cellule N3 qui est forcément le mois suivant et donc la feuille suivante dans le classeur (je ne sais pas si cela change quelque chose dans la conception de la macro) puisque l'utilisateur ne pourra pas entrer une durée supérieur à 20 jours.

N'hésitez pas si vous voulez des précision et merci à ceux qui ce pencheront sur le problème

Bonjour,

cela fait beaucoup de chose à vérifier par macro, mais malheureusement très difficile à vérifier sans un fichier à l'appuis.

merci de joindre un fichier pour nous aider à vous aider.

Re

Voici le tableau en question, toujours le même sauf que j'ai résolut le problème du N/A en cellule C8 depuis mais je remet ce fichier ici pour exemple.

Les autres mois sont exactement configuré de la même façon que janvier

Bonjour,

la majorité des plages ou cellules nommées de votre classeur font référence à une adresse erronée,

par exemple, Référence: ='C ds'!#REF!

c'est impossible de si retrouver...

Oups effectivement j'ai supprimer les feuilles pour allégé le fichier mais du coup les plages nommés ont sauté.

Voici le fichier mis à jour sans les erreur de plage

J'ai tenté un premier code je ne sais pas si je suis sur la bonne voie mais pour le moment cela ne marche pas si quelqu'un vois ou ce situe mon erreur dans ce code :

Sub recherche_colori()

Dim tblIndex() As Integer

'Tableau de 2 valeurs
ReDim tblIndex(1)

'Définition des 12 feuilles
tblIndex(0) = 6
tblIndex(1) = 17

nomcherche = Sheets("Para").Range("F3")

With Worksheets(tblIndex).Range("C7:AG122").Select      [u] Le débogueur m'indique l'erreur ce trouve ici[/u]

Set cellule = .Find(nomcherche, LookIn:=xlValues)
    If Not cellule Is Nothing Then cellule.Address.Font.ColorIndex = 4

    'Reste à ajouter le décallage de deux cellules vers le haut et une vers le bas ainsi que reprendre le principe du code pour mettre en rouge si nomcherche = Sheets("Para").Range("G3")

End With
End Sub

Du coup j'essaye déjà dans un premier temps de définir la plage de "JAN" à "DEC" (feuille 6 à 17) et les cellules de C7 à AG122 sans rechercher seulement dans la feuille ou la dernière valeur à été ajouté. J'essayerais d'optimiser quand j'aurais déjà compris ça

Voici la macro qui fonctionne mais je n'ai pas réussis à trouver comment mettre en couleurs également les deux cellules qui ce trouve au dessus ni celle qui ce trouve en dessous ...

Quelqu'un à une idée ?

Et je pense qu'il est également possible de réduire le code mais je ne sais pas comment ...

De plus cette macro effectue l'opération dans toutes les feuilles alors que je pense qu'il serait possible de mettre des conditions puisque la cellule qui ce situe dans la feuille Data en M3 donne le mois du début de la prestation de la dernière commande enregistrer et N3 le mois de fin de la prestation. Avec une condition il doit être possible de dire si cellule M3 = 1 et cellule N3 = 2 alors effectuer l'opération dans la feuille JAN et FEV mais je ne sais pas comment faire ...

Voici la Macro :

Sub recherche_colori_2()

Dim cel
Dim plage1 As Range

Set plage1 = Sheets("JAN").Range("C7:AG122")

For Each cel In plage1
    If cel.Text = Sheets("Para").Range("F3") Then
        cel.Interior.ColorIndex = 4

Else
    If cel.Text = Sheets("Para").Range("F4") Then
    cel.Interior.ColorIndex = 3

    End If
    End If
Next cel

Dim cel2
Dim plage2 As Range

Set plage2 = Sheets("FEV").Range("C7:AE122")

For Each cel2 In plage2
    If cel2.Text = Sheets("Para").Range("F3") Then
        cel2.Interior.ColorIndex = 4

Else
    If cel2.Text = Sheets("Para").Range("F4") Then
    cel2.Interior.ColorIndex = 3

    End If
    End If
Next cel2

Dim cel3
Dim plage3 As Range

Set plage3 = Sheets("MAR").Range("C7:AG122")

For Each cel3 In plage3
    If cel3.Text = Sheets("Para").Range("F3") Then
        cel3.Interior.ColorIndex = 4

Else
    If cel3.Text = Sheets("Para").Range("F4") Then
    cel.Interior.ColorIndex = 3

    End If
    End If
Next cel3

Dim cel4
Dim plage4 As Range

Set plage4 = Sheets("AVR").Range("C7:AF122")

For Each cel4 In plage4
    If cel4.Text = Sheets("Para").Range("F3") Then
        cel4.Interior.ColorIndex = 4

Else
    If cel4.Text = Sheets("Para").Range("F4") Then
    cel4.Interior.ColorIndex = 3

    End If
    End If
Next cel4

Dim cel5
Dim plage5 As Range

Set plage5 = Sheets("MAI").Range("C7:AG122")

For Each cel5 In plage5
    If cel5.Text = Sheets("Para").Range("F3") Then
        cel5.Interior.ColorIndex = 4

Else
    If cel5.Text = Sheets("Para").Range("F4") Then
    cel5.Interior.ColorIndex = 3

    End If
    End If
Next cel5

Dim cel6
Dim plage6 As Range

Set plage6 = Sheets("JUIN").Range("C7:AF122")

For Each cel6 In plage6
    If cel6.Text = Sheets("Para").Range("F3") Then
        cel6.Interior.ColorIndex = 4

Else
    If cel6.Text = Sheets("Para").Range("F4") Then
    cel6.Interior.ColorIndex = 3

    End If
    End If
Next cel6

Dim cel7
Dim plage7 As Range

Set plage7 = Sheets("JUIL").Range("C7:AG122")

For Each cel7 In plage7
    If cel7.Text = Sheets("Para").Range("F3") Then
        cel7.Interior.ColorIndex = 4

Else
    If cel7.Text = Sheets("Para").Range("F4") Then
    cel7.Interior.ColorIndex = 3

    End If
    End If
Next cel7

Dim cel8
Dim plage8 As Range

Set plage8 = Sheets("AOU").Range("C7:AG122")

For Each cel8 In plage8
    If cel8.Text = Sheets("Para").Range("F3") Then
        cel8.Interior.ColorIndex = 4

Else
    If cel8.Text = Sheets("Para").Range("F4") Then
    cel8.Interior.ColorIndex = 3

    End If
    End If
Next cel8

Dim cel9
Dim plage9 As Range

Set plage9 = Sheets("SEP").Range("C7:AF122")

For Each cel9 In plage9
    If cel9.Text = Sheets("Para").Range("F3") Then
        cel9.Interior.ColorIndex = 4

Else
    If cel9.Text = Sheets("Para").Range("F4") Then
    cel9.Interior.ColorIndex = 3

    End If
    End If
Next cel9

Dim cel10
Dim plage10 As Range

Set plage10 = Sheets("OCT").Range("C7:AG122")

For Each cel10 In plage10
    If cel10.Text = Sheets("Para").Range("F3") Then
        cel10.Interior.ColorIndex = 4

Else
    If cel10.Text = Sheets("Para").Range("F4") Then
    cel10.Interior.ColorIndex = 3

    End If
    End If
Next cel10

Dim cel11
Dim plage11 As Range

Set plage11 = Sheets("NOV").Range("C7:AF122")

For Each cel11 In plage11
    If cel11.Text = Sheets("Para").Range("F3") Then
        cel11.Interior.ColorIndex = 4

Else
    If cel11.Text = Sheets("Para").Range("F4") Then
    cel11.Interior.ColorIndex = 3

    End If
    End If
Next cel11

Dim cel12
Dim plage12 As Range

Set plage12 = Sheets("DEC").Range("C7:AG122")

For Each cel12 In plage12
    If cel12.Text = Sheets("Para").Range("F3") Then
        cel12.Interior.ColorIndex = 4

Else
    If cel12.Text = Sheets("Para").Range("F4") Then
    cel12.Interior.ColorIndex = 3

    End If
    End If
Next cel12

End Sub

Bonjour (..)

Proposition pour colorier le "bloc de cellules"

Sub recherche_colori_2()
Dim cel
Dim celCouleur          ' <= bloc de cellules a colorer
Dim plage1 As Range

Set plage1 = Sheets("JAN").Range("C7:AG122")

    For Each cel In plage1
        If cel.Text = Sheets("Para").Range("F3") Then
            Range(Cells(cel.Row - 2, cel.Column), Cells(cel.Row + 1, cel.Column)).Interior.ColorIndex = 4
            'cel.Interior.ColorIndex = 4

        Else
            If cel.Text = Sheets("Para").Range("F4") Then
                Range(Cells(cel.Row - 2, cel.Column), Cells(cel.Row + 1, cel.Column)).Interior.ColorIndex = 4
                'cel.Interior.ColorIndex = 3

            End If
        End If
    Next cel

End Sub

@ NCC

ça marche du tonnerre merci beaucoup

Si jamais je cherche également à résoudre le problème suivant mais celui ci n'est pas forcément ultra important c'est juste pour une question d'ergonomie et de rapidité d’exécution de la macro.

La manipulation de remplir les bloc doit être effectuer sur 2 feuilles en fonction des mois de la dernière valeurs ajouter en feuille "Data". Qui est toujours (une macro insère une nouvelle ligne) la cellule "M3" correspond au mois de début et la cellule "N3" au mois de fin. Soit une possibilité de 1 à 12

Le truc qui serait top ça serait de pouvoir dire à la macro, effectue la recherche de valeur pour remplissage dans la feuille "JAN" et "FEV" si "Data" M3 = 1 et N3 = 2

Ainsi de suite pour les 12 feuilles qui comportent les noms suivants :

JAN / FEV / MAR / AVR / MAI / JUIN / JUIL / AOU / NOV / DEC

(re)

J'avoue que je redoutais un peu la question...

franchement tel qu'est construit ton code et (surtout) tes tableaux il n'y a qu'un moyen :

Exécuter la procedure "colori_2" sur chaque onglet

ou bien mettre tes onglets (JAN,FEV...) dans un tableau et parcourir ce tableau dans "colori_2"

à prioir comme ça

Sub recherche_colori_2()
Dim cel
Dim celCouleur          ' <= bloc de cellules a colorer
Dim plage1 As Range

Dim tabOnglets(1 To 12)
Dim cptOnglet

    ' ATTENTION la liste ci-dessous doit reprendre EXACTEMENT le nom des onglets !!!
    tabOnglets(1) = "JAN"
    tabOnglets(2) = "FEV"
    '..
    tabOnglets(12) = "DEC"

    For cptOnglet = 1 To 12

        Set plage1 = Sheets(tabOnglets(cptOnglet)).Range("C7:AG122")

        For Each cel In plage1
            If cel.Text = Sheets("Para").Range("F3") Then
                Range(Cells(cel.Row - 2, cel.Column), Cells(cel.Row + 1, cel.Column)).Interior.ColorIndex = 4
                'cel.Interior.ColorIndex = 4

            Else
                If cel.Text = Sheets("Para").Range("F4") Then
                    Range(Cells(cel.Row - 2, cel.Column), Cells(cel.Row + 1, cel.Column)).Interior.ColorIndex = 4
                    'cel.Interior.ColorIndex = 3

                End If
            End If
        Next cel

    Next

End Sub

Je vais tester de bricoler ça plus tard

Sinon la solution à laquelle je pense et que je sais faire, c'est de faire une macro par mois, et d'appeler les macro selon condition 1 à 12

Je te tiens au courant quand j'aurais tester ça, merci pour les bloc en tout cas

(re)

Très mauvaise idée... Sauf si il y a une nécessité !

Ou alors tu as mal exprimé et tu veux dire "Créer un Fonction avec paramètres qui peut donc choisir le bon mois"

Par appelé je voulais dire utilisé la fonction call

Lorsque la nouvelle commande est enregistré alors si Data M3 = 1 call macro_correspondant_au_mois_de_janvier

Sinon si = 2 ; macro_fevrier

et un si de suite

Pourquoi serait ce une mauvaise idée ?

(re)

Parce que il est inutile (même idiot ) d'ecrire 12 fois la même chose à quelques variables près... L'informatique a été conçu pour simplifier pas pour démultiplier les procédures ou les petits pains !

Oui c'est vrai, mais ça marche quand même

Maintenant que cela marche et que cela est incrémenté à ma procédure d'enregistrement de commande je vais donc me pencher sur la solution que tu m'as donné pour alléger la macro et apprendre à programmer proprement

A toute quand j'ai trouvé !!!

(re)

Koko_Swiff a écrit :

Maintenant que cela marche et que cela est incrémenté à ma procédure d'enregistrement de commande je vais donc me pencher sur la solution que tu m'as donné pour alléger la macro et apprendre à programmer proprement

@ NCC

Je tente d'être un bonne élève

Alors j'ai donc essayer ton code suivant :

Sub recherche_colori_final()
Dim cel
Dim celCouleur          ' <= bloc de cellules a colorer
Dim plage1 As Range

Dim tabOnglets(1 To 12)
Dim cptOnglet

    ' ATTENTION la liste ci-dessous doit reprendre EXACTEMENT le nom des onglets !!!
    tabOnglets(1) = "JAN"
    tabOnglets(2) = "FEV"
    tabOnglets(3) = "MAR"
    tabOnglets(4) = "AVR"
    tabOnglets(5) = "MAI"
    tabOnglets(6) = "JUIN"
    tabOnglets(7) = "JUIL"
    tabOnglets(8) = "AOU"
    tabOnglets(9) = "SEP"
    tabOnglets(10) = "OCT"
    tabOnglets(11) = "NOV"
    tabOnglets(12) = "DEC"

    For cptOnglet = 1 To 12

    Sheets("JAN").Activate
    Range("C7").Select

        Set plage1 = Sheets(tabOnglets(cptOnglet)).Range("C7:AG122")

        For Each cel In plage1

            If cel.Text = Sheets("Para").Range("F3") Then
                Range(Cells(cel.Row - 2, cel.Column), Cells(cel.Row + 1, cel.Column)).Interior.ColorIndex = 4
                'cel.Interior.ColorIndex = 4 (vert)

            Else

            If cel.Text = Sheets("Para").Range("F4") Then
                    Range(Cells(cel.Row - 2, cel.Column), Cells(cel.Row + 1, cel.Column)).Interior.ColorIndex = 3
                    'cel.Interior.ColorIndex = 3 (rouge)

                End If
            End If

            Next cel

            Next

End Sub

Néanmoins ce qui est étonnant c'est que c'est mieux codé, mais, c'est plus long La raison est toute bête c'est que de cette façon la macro effectue l'opération dans les 12 pages à chaque fois

Ma question est donc la suivante, à quelle endroit de la macro puis je lui dire de prendre en fonction de la cellule M3 et N3 de la feuille "Data" la feuille tabOnglets correspondant. J'ai tenté plusieurs bricolage mais je ne doit pas bien m'y prendre car il n'as pas aimé la blague

Une autre question sûrement toute bête mais lorsque je tente cette macro avec en plus ajouter la condition suivante :

If cel.Text = Sheets("Para").Range("F6") Then
                cel.Interior.ColorIndex = xlColorIndexNone
                'cel.Interior.ColorIndex = sans couleur

                End If

Du coup il colorie également le bloc sans remplissage alors que je ne voudrais qu'il ne colorie que les cellule vide. J'ai donc tenter cette condition dans une nouvelle macro et ça marche très bien.

Mais du coup je me dit que c'est bête de faire deux macro pour trois conditions de couleurs sachant qu'une seule devrait pouvoir suffire (pour éviter de démultiplier les opérations )

Bonjour

S'il te plait... quand tu envoies un code... sélectionne-le et clique sur le bouton [Code] pour le mettre entre balises, sinon c'est illisible !

A tout de suite !

Bonjour

Voilà qui est fait !

(re)

C'est bien plus lisible comme ça...

Par contre désolé, mais peux-tu envoyer le fichier en PJ, c'est plus simple à tester...

(re)

Utilise cjoint http://www.cjoint.com/