VBA : Titres de tableau selon critères cochés

Bonsoir,

Je vous expose mon petit soucis :

J'aimerai faire un tableau dont les titres seraient liés à des critères.

J'ai une liste de 7 critères (sur excel, ce sont des cases à cocher). Le principe, c'est que si le premier critère est coché, alors son nom se met dans le titre de la première. Si le second est coché, alors il va dans le titre de la deuxième colonne. En revanche, lorsqu'un critère n'est pas coché, alors la macro ne met pas son nom dans le titre de la colonne suivante.

L'intérêt est de créer un tableau propre, dont les titres sont mis en forme en fonction des critères sélectionnés.

J'ai tenté d'écrire un code afin de faire cette action, mais ça ne marche pas.

Si le premier critère est coché, alors il se met dans tous les titres (soit 7 colonnes). Si ce premier critère n'est pas coché, alors même si les autres sont cochés les titres restent vides.

Voici mon code, qui pose soucis donc :

Sub Test()

Dim CL As String 'Liste de critères dans 'Criteria List'
Dim CC As Boolean 'Check si critère coché ou non (VRAI/FAUX)
'si ce type ne marche pas pour CC, essayer le type Boolean
Dim K As Byte 'variable à incrémenter à la fin de la bouche si vrai
Dim i As Byte 'numéro de ligne de CL
Dim j As Byte 'numéro de la ligne de CC
Dim MsgErr As String

Range("A19:O10000").Clear 'efface la partie critere
Range("B20").Value = "Ticker"
Range("C20").Value = "Company"

MsgErr = "Erreur, cf code VBA"

K = 4
i = 2 'ligne liste critères dans 'Criteria List'
j = 10 'ligne liste critères dans 'Feuil2'
CL = Worksheets("Criteria List").Range("A" & i).Value 'Critère Liste
CC = Worksheets("Feuil2").Range("A" & j).Value 'Check Critères

For j = 10 To 16
    Select Case CC
    Case Is = "VRAI"
        Cells(20, K).Value = CL
        K = K + 1
        i = i + 1
    Case Is = "FAUX"
        i = i + 1
    Case Else
        MsgBox MsgErr
    End Select
Next j

End Sub

J'ai pour le moment laissé apparaître en dessous ce que renvoie la case (VRAI/FAUX) pour faciliter le code.

Dans une autre feuille (invisible à l'utilisateur, c'est plus propre), j'ai créé une liste "tampon", avec dedans le nom de chaque critère.

Je pars du principe que si le contenu derrière la case à cocher est "VRAI", alors il devrait stocker dans le titre d'une colonne le contenu que j'ai associé dans la feuille "tampon".

Quelqu'un aurait une idée pour résoudre ce problème ?

Cordiales salutations,

Alex.

Bonsoir

Alex Nygal a écrit :

Quelqu'un aurait une idée pour résoudre ce problème ?

Sans le fichier c'est sur que je n'ai pas d'idée

Avec le fichier cela sera plus probable (mais pas sur)

Tu y indiques ce que tu veux obtenir

Voilà un fichier type (que j'ai modifié et simplifié, c'est plus simple pour vous car il n'y a plus que ce soucis qui apparaît et pas tout le reste du programme).

Les critères associés sont stockés dans la seconde feuille (Criteria List)

Là par exemple, dans le fichier joint où les critères A, B, E et G sont cochés, pour les titres on devrait avoir (dans l'ordre) :

Ticker, Company, Crit. A, Crit. B, Crit. E, Crit. G.

Or c'est "Crit. A" qui apparaît, et en plus dans les 7 titres alors que seulement 4 devraient apparaître.

Bonsoir,

proposition de correction de ton code

Sub Test()

Dim CL As String 'Liste de critères dans 'Criteria List'
Dim CC As Boolean 'Check si critère coché ou non (VRAI/FAUX)
'si ce type ne marche pas pour CC, essayer le type Boolean
Dim K As Byte 'variable à incrémenter à la fin de la bouche si vrai
Dim i As Byte 'numéro de ligne de CL
Dim j As Byte 'numéro de la ligne de CC
Dim MsgErr As String

Range("A19:O10000").Clear 'efface la partie critere
Range("B20").Value = "Ticker"
Range("C20").Value = "Company"

MsgErr = "Erreur, cf code VBA"

K = 4
i = 2 'ligne liste critères dans 'Criteria List'
j = 10 'ligne liste critères dans 'Feuil2'

For j = 10 To 16
    CC = Worksheets("Feuil2").Range("A" & j).Value 'Check Critères
    Select Case CC
    Case True
        CL = Worksheets("Criteria List").Range("A" & i).Value 'Critère Liste
        Cells(20, K).Value = CL
        K = K + 1
        i = i + 1
    Case False
        i = i + 1
    Case Else
        MsgBox MsgErr
    End Select
Next j

End Sub

Bonsoir

Bonsoir h2so4

Vérifies si cela te convient

Option Explicit

Sub Test()
Dim Col As Integer    ' Numéro de la colonne
Dim J As Long         ' Numéro de la ligne

  Col = 4

  With Sheets("Feuil2")
    .Range("A19:O10000").Clear 'efface la partie critere
    .Range("B20").Value = "Ticker"
    .Range("C20").Value = "Company"
    For J = 10 To 16
      If .Range("A" & J).Value = True Then         'Check Critères
        ' Ligne 10 dans la page "Feuil2" correspond à la ligne 2 page "Criteria List"
        .Cells(20, Col).Value = Sheets("Criteria List").Range("A" & J - 8).Value 'Critère Liste
        Col = Col + 1
      End If
    Next J
  End With
End Sub

Les deux solutions marchent parfaitement bien lorsque je l'ai adapté à mon programme. Merci à vous deux Banzai64 et h2so4 !

Je vais préférer ici la proposition de Banzai64, qui me semble un peu plus simple à la compréhension, donc sûrement plus souple pour des possibles modifications à venir.

h2so4, je garde évidemment ta proposition sous le coude si les choses se gâtent par la suite. Je te remercie par ailleurs pour le travail d'adaptation que tu as fait sur le code déjà existant, qui ne devait probablement pas être optimisé pour l'action que je souhaitai faire.

En espérant que cette première partie de mon code convienne à ce que je souhaite faire plus tard. Dans le cas échéant j'aurai tout de même appris un certain nombre de choses (et c'est là l'essentiel) grâce à ces deux propositions.

En vous souhaitant une bonne fin de soirée,

Cdlmt,

Alex