Macro VBA suivi projets

Bonjour,
je suis nouveau ici et je vous serais très reconnaissant si quelqu'un pouvait m'aider avec une macro que je dois développer pour mon projet.

J'ai déjà commencé à travailler sur une macro, mais elle n'est pas encore terminée et je rencontre quelques difficultés pour la finaliser. Pour vous donner un peu de contexte, ma macro doit analyser une ligne intitulée "TdB". Elle examinera les projets dans la dernière ligne en tenant compte de leur phase et de leur jalon. Le projet en phase et jalon actuels est marqué en rouge. Cependant, si la phase du projet n'est pas encore passée, elle est colorée en vert, et les phases suivantes non atteintes sont marquées en blanc.

Mon objectif est de créer un résultat similaire à celui présenté dans la seconde image sous le titre "Expectative". Si quelqu'un peut m'offrir de l'aide ou des orientations sur comment procéder, je vous en serais extrêmement reconnaissant.

Merci d'avance pour votre aide et votre temps

Macros:

Sub ApplyCombinedConditionalColors()
    Dim ws As Worksheet, wsJalons As Worksheet
    Set ws = ThisWorkbook.Sheets("Tbd")
    Set wsJalons = ThisWorkbook.Sheets("Jalons_tdb")

    Dim checkRange As Range
    Set checkRange = ws.Range("C27:Q51")

    Dim cell As Range, cellToLeft As Range, cellToRight As Range
    Dim matchedRow As Variant
    Dim phaseName As String
    Dim columnLetter As String

    ' Effacer les couleurs précédentes
    checkRange.Interior.ColorIndex = xlNone

    ' Parcourir chaque cellule dans la plage spécifiée
    For Each cell In checkRange
        columnLetter = Split(cell.Address, "$")(1)
        phaseName = DeterminePhase(columnLetter)

        ' Rechercher une correspondance dans les jalons
        matchedRow = Application.Match(ws.Cells(cell.Row, 2).Value, wsJalons.Columns("J"), 0)

        ' Si une correspondance est trouvée et que la phase correspond
        If Not IsError(matchedRow) And wsJalons.Cells(matchedRow, 11).Value = phaseName Then
            ' Définir la couleur de la cellule actuelle
            SetColor cell, wsJalons, matchedRow, phaseName, checkRange
        Else
            ' Effacer la couleur si la condition n'est pas remplie
            cell.Interior.ColorIndex = xlNone
        End If
    Next cell
End Sub

' Fonction pour déterminer la phase en fonction de la lettre de la colonne
Function DeterminePhase(columnLetter As String) As String
    Select Case columnLetter
        Case "C", "D", "E", "F", "G"
            DeterminePhase = "Cadrage & SFG"
        Case "H", "I", "J", "K", "L"
            DeterminePhase = "Fabrication"
        Case "M", "N"
            DeterminePhase = "Recette"
        Case "O", "P"
            DeterminePhase = "MEP"
        Case "Q", "R"
            DeterminePhase = "Déploiement & VSR"
        Case Else
            DeterminePhase = ""
    End Select
End Function

' Sub-procedure pour définir la couleur en fonction des cellules voisines et de la correspondance
Sub SetColor(ByRef cell As Range, wsJalons As Worksheet, matchedRow As Variant, phaseName As String, checkRange As Range)
    Dim cellToLeft As Range, cellToRight As Range

    ' Définir les cellules voisines
    If cell.Column > 1 Then
        Set cellToLeft = cell.Offset(0, -1)
    End If
    If cell.Column < checkRange.Columns.Count Then
        Set cellToRight = cell.Offset(0, 1)
    End If

    ' Appliquer la logique des couleurs
    If Not cellToLeft Is Nothing Then
        If cellToLeft.Interior.Color = RGB(255, 0, 0) Then ' rouge à gauche
            cell.Interior.Color = RGB(0, 255, 0) ' vert
        End If
    End If

    If Not cellToRight Is Nothing Then
        If cellToRight.Interior.Color = RGB(255, 0, 0) Then ' rouge à droite
            cell.Interior.Color = RGB(255, 255, 255) ' blanc
        End If
    End If

    If cell.Interior.ColorIndex = xlNone Then ' Si aucune des conditions ci-dessus n'a été appliquée
        cell.Interior.Color = RGB(255, 0, 0) ' rouge
    End If
End Sub

Bonsoir Emycc,

Pour bien comprendre, c'est ça que tu veux obtenir :

Pour chaque ligne, on colore en vert jusqu'à atteindre la cellule marquée comme rouge, passé cette cellule on laisse en blanc.

Je vois que ton tableau est divisé en 5 parties : Cadre, Fab, Rec Mep et Dév, on n'en tient pas compte ?

Edit : si une ligne ne contient pas le terme rouge, on laisse la ligne blanche ?

klin89

Bonsoir,
Klin89 bonsoir,

Le tableau se met à jour suite à des formules, donc vous devez lancer la macro pour mettre à jour ces couleurs ?
Je vous propose une solution par MFC où :
si = à "rouge" = rouge
s'il y a au moins un "rouge" à droite de la cellule testée et que celle-ci n'est pas égale à rouge alors vert

Le fichier :

@ bientôt

LouReeD

bonjour @klin89
Merci pour votre réponse.
Je vous transmets mes précission en coleur "vert"

Pour chaque ligne, on colore en vert jusqu'à atteindre la cellule marquée comme rouge, passé cette cellule on laisse en blanc - Oui, c’est exactement cela.

Je vois que ton tableau est divisé en 5 parties : Cadre, Fab, Rec Mep et Dév, on n'en tient pas compte ? – Je dois bien tenir compte de cette division pour localiser et
marquer correctement la cellule rouge en relation avec la deuxième onglet, qui sera mis à jour chaque semaine

Edit : si une ligne ne contient pas le terme rouge, on laisse la ligne blanche ? – En général, toute la ligne contiendra le terme rouge, car toutes les
cellules vertes représentent des jalons déjà passés, et la cellule rouge indique l'état actuel.

En fait, je n'ai fait apparaître les lettres "vert" et "rouge" (dans une formule) que pour différencier les cellules et marquer où elles se situent, mais je voulais seulement que la cellule soit colorée

Merci encore pour votre temps et vos efforts.

bonne journée

Bonjour LouReeD!
c'est exactement ce que je voulais! merci beaucoup pour votre réponse!
Juste une dernière questions:
en cas je voudrais mets la première formule comme macro (ce qui cherche les valeurs de l'onglet "Jalons_tdb" vers le positionner dans le graphique "Tdb")
=SI(Jalons_tdb!$C2=Tdb!B$3;SI(Jalons_tdb!$D2="Cadre";"rouge";"vert");"vert");
=SI(Jalons_tdb!$C2=Tdb!G$3;SI(Jalons_tdb!$D2="Fab";"rouge";"vert");"vert"); =SI(Jalons_tdb!$C2=Tdb!L$3;SI(Jalons_tdb!$D2="Rec";"rouge";"vert");"vert") etc...

Serait-il possible d'utiliser la macro suivante?

Sub AppliquerFormulesEtMasquerTexte()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Tdb")

    ' Appliquer les formules et masquer le texte
    With ws
        ' Première plage de formules de B3 à F3
        .Range("B3:F3").Formula = "=IF(Jalons_tdb!$C2=Tdb!B$3, IF(Jalons_tdb!$D2=""Cadre"", ""rouge"", ""vert""), ""vert"")"
        .Range("B3:F3").Font.Color = .Range("B3:F3").Interior.Color

        ' Deuxième plage de formules de G3 à K3
        .Range("G3:K3").Formula = "=IF(Jalons_tdb!$C2=Tdb!G$3, IF(Jalons_tdb!$D2=""Fab"", ""rouge"", ""vert""), ""vert"")"
        .Range("G3:K3").Font.Color = .Range("G3:K3").Interior.Color

        ' Troisième plage de formules de L3 à N3
        .Range("L3:N3").Formula = "=IF(Jalons_tdb!$C2=Tdb!L$3, IF(Jalons_tdb!$D2=""Rec"", ""rouge"", ""vert""), ""vert"")"
        .Range("L3:N3").Font.Color = .Range("L3:N3").Interior.Color

        ' Quatrième plage de formules de O3 à P3
        .Range("O3:P3").Formula = "=IF(Jalons_tdb!$C2=Tdb!O$3, IF(Jalons_tdb!$D2=""Dév"", ""rouge"", ""vert""), ""vert"")"
        .Range("O3:P3").Font.Color = .Range("O3:P3").Interior.Color
    End With
End Sub

Merci encore pour votre réponse et vos temps

Bien cordialement.

Bonjour,

oups ! Là je ne comprend plus...

@ bientôt

LouReeD