Incrémentation données et couleurs dans cellule

Bonjour!

J'ai fais une macro qui consiste à récupérer des informations dans l'onglet "Etat" pour les mettre dans le bon onglet et dans le bon croissement ligne / colonne (article / semaine). De plus, j'ai ajouté une couleur de fond dans la cellule pour avoir une info visuelle de l'état d'avancement ("Vérifié", "A faire" ou "A risque").

Le problème que je rencontre maintenant c'est que je peux avoir plusieurs fournisseurs et plusieurs états d'avancement pour un article et une semaine et j'aimerai avoir toutes les informations dans une seule cellule. Savez vous comment faire?

Merci d'avance,

EloM91

Je vous joins le fichier et ci dessous le morceau de code impliqué :

Sub MAJplanning()

Dim semaine As Integer
Dim i As Integer, k As Integer
Dim DerniereLigne As Long
Dim Perimetre As String, Article As String, ValeurSem As String, Fnr As String, Etat As String, Fnr1 As String
Dim CellTrouvee As Range
Dim celluletrouvee As Range, ColSemaine As Range
Dim ligne As Integer
Dim col As Integer

'Aller onglet Etat
Sheets("Etat").Activate

'Déterminer la dernière ligne
DerniereLigne = 2   'Première ligne à vérifier
Do While Not IsEmpty(Range("A" & DerniereLigne))
    DerniereLigne = DerniereLigne + 1
Loop

'Récupérer les données
For k = 2 To DerniereLigne - 1

    Sheets("Etat").Activate
    Perimetre = Cells(k, 1).Value
    Article = Cells(k, 2).Value
    ValeurSem = Cells(k, 3).Value
    Fnr = Cells(k, 4).Value
    Etat = Cells(k, 5).Value

    For i = 2 To 5

        Sheets(i).Activate

        Set celluletrouvee = Range("B1:B50").find(Article, lookat:=xlWhole)
        Set ColSemaine = Range("C2:AZ2").find(ValeurSem, lookat:=xlWhole)
        If Not celluletrouvee Is Nothing Then
            ligne = celluletrouvee.Row
            col = ColSemaine.Column
            If ActiveSheet.Name = Perimetre Then
                Cells(ligne, col) = Fnr
                If Etat = "Vérifié" Then
                    Cells(ligne, col).Interior.ColorIndex = 4       'Vérifié : Fond vert
                ElseIf Etat = "A faire" Then
                    Cells(ligne, col).Interior.ColorIndex = 45      'A faire : Fond orange
                ElseIf Etat = "A risque" Then
                    Cells(ligne, col).Interior.ColorIndex = 3       'A risque : Fond rouge
                End If
                Columns("C:ZZ").AutoFit
            End If
        End If

    Next i

Next k

End Sub

Bonjour EloM91,

Pour ajouter tous les fournisseurs dans la même cellule :

Cells(ligne, col) = Cells(ligne, col) & vbcrlf & Fnr

Pour la cellule état, il faut peut-être que tu fixes une règle de préséance : "Vérifié", "A faire" ou "A risque"?

Bonjour GVIALLES,

Merci pour la réponse. Je vais regarder ton code de suite.

Que veux tu dire par "règle de préséance"?

Merci d'avance,

Elodie

Re!

Ton code fonctionne très bien par contre, lorsqu'il n'y a qu'un seul fournisseur par cellule, le nom du fournisseur s'inscrit sur la deuxième ligne de la cellule donc j'ai repris ton code pour mettre :

Cells(ligne, col) =  Fnr & vbcrlf & Cells(ligne, col)

Mais la ligne existe toujours (sous le nom du fournisseur) ce qui donne une drôle de tête à mes cellules :

As tu une idée d'amélioration?

Merci d'avance,

Elodie

Je voulais dire que, si j'ai bien compris, plusieurs fournisseurs = plusieurs états. Donc pour la colorisation de la dernière cellule il faudrait décider quel état prendre.

Suis-je clair?

Bonjour,

Ou sinon, est ce que tu penses que ce serait possible lorsqu'il y a plusieurs fournisseurs différents de créer une ligne en plus et de fusionner les autres pour avoir les différentes couleurs dans ce style là ?

Merci,

Elodie

Bonjour EloM91,

Pour l'amélioration de la présentation des fournisseurs, une suggestion :

Cells(ligne, col) = "- " & Fnr & vbcrlf & Cells(ligne, col)

Pour les états, ce que tu veux est possible mais avec un effort de programmation supplémentaire: cela consiste à

• Insérer une ligne au bon endroit :
• Fusionner les cellules devant la cellule fournisseur, centrer verticalement le texte à l'intérieur de ces cellules
• Affecter la bonne couleur à la la cellule fournisseur.

Pour tous ça, je te conseille de passer dans un premier temps par l'enregistrement macro (de l'onglet Developpeur) et de te servir du code généré. Mais peut-être connais-tu déjà tout ça...

En cas de besoin, je peux t'aider pour la suite.

Pour l'amélioration, lorsque je lance la macro j'obtiens :

alors que je voudrais quelque chose comme ca :

Tu penses que c'est possible?

Ok, pour le reste je regarde de mon côté et je te tiens au courant.

Elodie

Elodie,

Après l'instruction :

Cells(ligne, col) = "- " & Fnr & vbcrlf & Cells(ligne, col)

essais d'ajouter :

Cells(ligne, col).Wraptext = false

Cells(ligne, col).Columns.Autofit