Macro de mise en forme très conditionnelle

Bonjour à tous,

Nouveau sur ce forum, je me lance pour cause de galère au boulot et j'en appelle donc à votre expertise et votre gentillesse pour peut-être m'aider à résoudre mon problème.

J'ai bien essayé de trouver un problème similaire pour m'en inspirer mais je crois que mes conditions sont trop particulières... Je m'explique :

Pour le boulot, je suis chargé de simplifier un tableau d'environ 32500 lignes de données. N'étant pas sûr du degré de confidentialité de mon travail, je vais rester assez vague (voire fictif) sur les notions de l'entreprise mais j'essaierai d'être aussi précis que possible sur le code (ce qui finalement vous importe vraiment).

Il s'agit de références de produits qui sont listées en colonne A, et qui apparaissent plusieurs fois car elles peuvent être utilisée par plusieurs "groupes fonctionnels" (colonne C) et dans différentes usines, sur plusieurs projets.

Mon travail est de regrouper les références de telle sorte qu'il y ait une seule ligne par référence, et que la police soit rouge si la référence est utilisée par au moins un groupe fonctionnel "spécial". Les groupes fonctionnels standards sont désigné par un code à deux chiffres, les groupes spéciaux par un code d'une lettre (B, E, H, M ou P) et d'un chiffre.

Je vous fais un petit tableau ultra condensé pour vous rendre compte de mon souhait :

Tableau actuel :

Ce que je cherche à faire pour le moment :

Tableau final souhaité :

J'ai déjà remplacé les nombres dans le tableau (qui représentent les consommations de chaque référence par projet) par des "X", et j'ai une macro qui met toutes les données sur la même ligne, que j'utiliserai après avoir réussi à mettre en forme.

Je cherche donc désespérément un moyen de mettre en forme toutes les lignes concernées par une référence qui est utilisée par au moins un groupe standard ET un groupe spécial. Je précise donc que je me concentre uniquement sur le passage du premier au deuxième tableau, pour le passage au troisième j'ai normalement déjà ce qu'il faut.

Je vous montre ci-dessous la macro sur laquelle je travaille mais qui évidemment ne fonctionne pas :

Dim Lig As Long, l As Integer, m As Integer, n As Integer, txt As String
Lig = Range("A65536").End(xlUp).Row
m = 0

For l = lig To 3 Step -1

        If Cells(l, 1) = Cells(l - 1, 1) Then

            m = m + 1

            ElseIf m > 1 Then
                For n = l + m To l Step -1
                    txt = Cells(n, 3).Value
                    If (Left(txt, 1) = "B" Or Left(txt, 1) = "E" Or Left(txt, 1) = "H" _
                    Or Left(txt, 1) = "M" Or Left(txt, 1) = "P") Then

                        Range(Rows(l), Rows(l + m)).Select
                        With Selection.Font
                        .Color = -16776961
                        .TintAndShade = 0
                        End With
                    End If
                Next n
            End If
Next l

En vous remerciant par avance pour vos contributions

Bonsoir,

Essayer ce code :

    Dim cell_GF As Range, cell_REF As Range
    Dim i As Long

    With ActiveSheet.UsedRange
        For Each cell_GF In .Columns("B").Cells
            If cell_GF Like "[BEHMP]#" Then
                i = cell_GF.Row  'indice ligne
                Set cell_REF = .Columns("A").Find(.Cells(i, "A"))
                If Not cell_REF Is Nothing Then
                    Set cell1_REF = cell_REF
                    Do
                        i = cell_REF.Row  'indice ligne
                        .Rows(i).Font.Color = -16776961
                        Set cell_REF = .Columns("A").FindNext(cell_REF)
                    Loop Until cell_REF.Address = cell1_REF.Address
                End If
            End If
        Next cell_GF
    End With

Wow. Ça marche du tonnerre.

Un grand merci à toi Thev.

Mes conditions ont changé depuis que j'ai posté le message, maintenant c'est en orange que ça doit apparaître donc j'ai changé la couleur sans problème, mais j'ai une condition supplémentaire : Si tous les groupes fonctionnels pour une référence sont des groupes spéciaux (commençant par une lettre), je dois passer en rouge toutes les lignes de cette référence. Je vais plancher là-dessus, a priori ça devrait être plus simple que ma première condition donc j'espère y arriver sans trop de mal, mais je reste ouvert à toute proposition

Bon jour,

Proposition pour nouvelle conditions

    Dim cell_GF As Range, cell_REF As Range, lignes_GS As Range
    Dim i As Long, nb_lignes_coloriées
    Const GS As String = "[BEHMP]#"

    With ActiveSheet.UsedRange
        For Each cell_GF In .Columns("B").Cells
            If cell_GF Like GS Then
                i = cell_GF.Row  'indice ligne
                nb_lignes_coloriées = 0
                Set lignes_GS = Nothing
                Set cell_REF = .Columns("A").Find(.Cells(i, "A"))
                If Not cell_REF Is Nothing Then
                    Set cell1_REF = cell_REF
                    Do
                        i = cell_REF.Row  'indice ligne
                        ' affectation couleur
                        .Rows(i).Font.Color = 49407
                        nb_lignes_coloriées = nb_lignes_coloriées + 1
                       ' stockage lignes groupes spéciaux
                        If .Cells(i, "B") Like GS Then
                            If lignes_GS Is Nothing Then Set lignes_GS = .Rows(i) _
                            Else Set lignes_GS = Union(.Rows(i), lignes_GS)
                        End If
                        ' recherche cellule suivante
                        Set cell_REF = .Columns("A").FindNext(cell_REF)
                    Loop Until cell_REF.Address = cell1_REF.Address
                    'recoloriage si nb lignes groupes spéciaux = nb lignes coloriées
                    If lignes_GS.Rows.Count = nb_lignes_coloriées Then lignes_GS.Font.Color = -16776961
                End If
            End If
        Next cell_GF
    End With

Encore une fois, ça fonctionne parfaitement.

Merci beaucoup pour ton aide thev.