XL 2013 creer un rapport base sur trois tables dont les cellules sont en bleu couleur de fond

[DJAMAL]

Merci pour le coup de mains

 

[Robert]

Bonjour Djamal, bonjour le forum,

Attention le second onglet de ton classeur contient un espace à la fin (Rapport ). Il faut le supprimer (Rapport) pour que le code ci-dessous fonctionne. Tu n'as pas précisé ce que tu voulais dans la colonne CT ?
Le code :

Sub Macro1()
Dim RJ As Worksheet 'déclare la variable RJ (onglet Runs Journalieres)
Dim R As Worksheet 'déclare la variabel R (onglet Rapport)
Dim PL(1 To 3) As Range 'déclare le tableau TL de 3 plages de PL1 à PL3
Dim I As Byte 'déclare la variabel I (Incrémet)
Dim J As Integer 'déclare la variabel J (incrément)
Dim K As Integer 'déclare la variabel K (incrément)
Dim TL() As Variant 'déclare la variabel TL (Tableau des lignes)

Set RJ = Worksheets("Runs Journalieres") 'définit l'onglet RJ
Set R = Worksheets("Rapport ") 'définit l'onglet R
Set PL(1) = RJ.Range("B3").CurrentRegion 'définit la plage PL(1)
Set PL(2) = RJ.Range("E3").CurrentRegion 'définit la plage PL(2)
Set PL(3) = RJ.Range("H3").CurrentRegion 'définit la plage PL(3)
For J = 1 To 3 'boucle 1 : sur les 3 plages
    For I = 4 To PL(J).Rows.Count 'boucle 2 sur toutes les lignes I de la plage de la boucle 1
        'condition : si la cellule ligen I colonne 2 de la plage PL(J) a le fond bleu
        If PL(J)(I, 2).Interior.Color = 14994616 Then
            K = K + 1 'incrémente T
            ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 ligne, K colonnes)
            TL(1, K) = PL(J)(I, 2) 'récupère la valeur de la cellule dans la ligne 1 de Tl
            TL(2, K) = "Run" & J 'récupère le numéro du Run dans la ligne 2 de TL
            TL(3, K) = "?" 'tu n'as pas précisé alors j'ai mis ? dans la ligne 3 de TL (met "" si tu ne veux rien)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
Next J 'prochaine plage de la boucle 1
R.Range("A3").CurrentRegion.ClearContents 'efface d'éventuelles ancienne données
R.Range("A4").Resize(K, 3).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans la cellule A4 redimensionnée de l'onglet R
End Sub

 

[DJAMAL]

Bonjour Djamal, bonjour le forum,

Attention le second onglet de ton classeur contient un espace à la fin (Rapport ). Il faut le supprimer (Rapport) pour que le code ci-dessous fonctionne. Tu n'as pas précisé ce que tu voulais dans la colonne CT ?
Le code :

Sub Macro1()
Dim RJ As Worksheet 'déclare la variable RJ (onglet Runs Journalieres)
Dim R As Worksheet 'déclare la variabel R (onglet Rapport)
Dim PL(1 To 3) As Range 'déclare le tableau TL de 3 plages de PL1 à PL3
Dim I As Byte 'déclare la variabel I (Incrémet)
Dim J As Integer 'déclare la variabel J (incrément)
Dim K As Integer 'déclare la variabel K (incrément)
Dim TL() As Variant 'déclare la variabel TL (Tableau des lignes)

Set RJ = Worksheets("Runs Journalieres") 'définit l'onglet RJ
Set R = Worksheets("Rapport ") 'définit l'onglet R
Set PL(1) = RJ.Range("B3").CurrentRegion 'définit la plage PL(1)
Set PL(2) = RJ.Range("E3").CurrentRegion 'définit la plage PL(2)
Set PL(3) = RJ.Range("H3").CurrentRegion 'définit la plage PL(3)
For J = 1 To 3 'boucle 1 : sur les 3 plages
    For I = 4 To PL(J).Rows.Count 'boucle 2 sur toutes les lignes I de la plage de la boucle 1
        'condition : si la cellule ligen I colonne 2 de la plage PL(J) a le fond bleu
        If PL(J)(I, 2).Interior.Color = 14994616 Then
            K = K + 1 'incrémente T
            ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 ligne, K colonnes)
            TL(1, K) = PL(J)(I, 2) 'récupère la valeur de la cellule dans la ligne 1 de Tl
            TL(2, K) = "Run" & J 'récupère le numéro du Run dans la ligne 2 de TL
            TL(3, K) = "?" 'tu n'as pas précisé alors j'ai mis ? dans la ligne 3 de TL (met "" si tu ne veux rien)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
Next J 'prochaine plage de la boucle 1
R.Range("A3").CurrentRegion.ClearContents 'efface d'éventuelles ancienne données
R.Range("A4").Resize(K, 3).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans la cellule A4 redimensionnée de l'onglet R
End Sub

merci beaucoup c´est génial

 

[DJAMAL]

merci beaucoup c´est génial

Bonsoir c´est encore moi
j ´ai essayé de créer une simulation avec 10 tableaux < avec le même principe > mais je bute toujours
voulez-vous jetter un coup d´oeil sur le code vba que jái adapter avec le votre
merci
je joins le fichier

 

[Robert]

Re Djamal,

Je ne comprends pas pourquoi la couleur n'était plus prise en compte. Du coup, j'ai pris D3 comme référence dans le code. Tu avais encore un espace en trop dans le nom pour l'onglet Rapport de Biobanque (code) et tu partais de la ligne 15 dans la boucle 2, alors qu'à partir du moment où la plage est définie on ne compte que les lignes de la plage. Dans ton cas on part de la ligne 4.
Le code :

Sub Macro1()
Dim RJ As Worksheet 'déclare la variable RJ (onglet Runs Journalieres)
Dim RD As Worksheet 'déclare la variable RD (onglet rapport de détecté>30)
Dim RB As Worksheet 'déclare la variabel RB (onglet Rapport de Biobanque)
Dim COUL1 As Long 'déclare la variable COUL1 (COULeur 1)
Dim PL(1 To 10) As Range 'déclare le tableau TL de 10 plages de PL1 à PL10
Dim I As Byte 'déclare la variabel I (Incrémet)
Dim J As Integer 'déclare la variabel J (incrément)
Dim K As Integer 'déclare la variabel K (incrément)
Dim TL() As Variant 'déclare la variabel TL (Tableau des lignes)

Set RJ = Worksheets("Runs Journalieres") 'définit l'onglet RJ
COUL1 = RJ.Range("D3").Interior.Color 'définit la couleur de référence COUL1
Set RB = Worksheets("Rapport de Biobanque") 'définit l'onglet RB
Set PL(1) = RJ.Range("B14").CurrentRegion 'définit la plage PL(1)
Set PL(2) = RJ.Range("E14").CurrentRegion 'définit la plage PL(2)
Set PL(3) = RJ.Range("H14").CurrentRegion 'définit la plage PL(3)
Set PL(4) = RJ.Range("K14").CurrentRegion 'définit la plage PL(4)
Set PL(5) = RJ.Range("N14").CurrentRegion 'définit la plage PL(5)
Set PL(6) = RJ.Range("Q14").CurrentRegion 'définit la plage PL(6)
Set PL(7) = RJ.Range("T14").CurrentRegion 'définit la plage PL(7)
Set PL(8) = RJ.Range("W14").CurrentRegion 'définit la plage PL(8)
Set PL(9) = RJ.Range("Z14").CurrentRegion 'définit la plage PL(9)
Set PL(10) = RJ.Range("AC14").CurrentRegion 'définit la plage PL(10)

For J = 1 To 10 'boucle 1 : sur les 10 plages
    For I = 4 To PL(J).Rows.Count 'boucle 2 sur toutes les lignes I de la plage de la boucle 1
        'condition : si la cellule ligen I colonne 2 de la plage PL(J) a le fond bleu
        If PL(J)(I, 2).Interior.Color = COUL1 Then
            K = K + 1 'incrémente K
            ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 ligne, K colonnes)
            TL(1, K) = PL(J)(I, 2) 'récupère la valeur de la cellule dans la ligne 1 de Tl
            TL(2, K) = "Run" & J 'récupère le numéro du Run dans la ligne 2 de TL
            TL(3, K) = "?" 'tu n'as pas précisé alors j'ai mis ? dans la ligne 3 de TL (met "" si tu ne veux rien)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
Next J 'prochaine plage de la boucle 1
RB.Range("E3").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles ancienne données
If K > 0 Then RB.Range("E4").Resize(K, 3).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans la cellule E4 redimensionnée de l'onglet R
End Sub

 

[DJAMAL]

Genial , merci encore