Faire apparaître une liste d'éléments s'ils sont cochés

[ipotez]

Salut
J'ai crée un classeur sur lequel je dois cocher (sous forme de x) certains items classés par module.
Dans une feuille recap, je dois récupérer la liste des items cochés, et le nom du module.

Problème : Lorsqu'aucun des items n'est coché, comment ne pas faire apparaître le nom du module ? Comment récupérer les items cochés et le nom du module lorsqu'un ou plusieurs items sont cochés ?

J'ai mis un fichier pour que ce soit plus clair
Merci beaucoup de votre aide

 

[James007]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Salut lulu,

Puisque tu sembles au début de ton projet, (je fais cette hypothèse ...) ci joint une proposition qui anticipe un peu sur le futur ... et qui garantit une souplesse totale ...

voir fichier test joint ...

A +

 

[ipotez]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Salut 007 ^^

Bonne piste les TCD mais malheureusement les données sources ne sont pas présentées sous forme de base de données (contrainte boulot).
En plus je trouve que la structure du TCD est difficile à intégrer proprement dans le classeur, celui ci doit ressembler à une présentation word, contrainte boulot...
Merci en tout cas pour ta réponse !!!!
Une autre idée ?

 

[job75]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Bonsoir,

Amusant, c'est pratiquement le même problème que celui de ce fil :

https://www.excel-downloads.com/threads/recherche-retournant-plusieurs-lignes.156071/

Alors cette macro dans le code de la feuille RECAP :

Private Sub Worksheet_Activate()
Dim i As Long
Application.ScreenUpdating = False
Sheets("SAISIE").Cells.Copy Cells
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
  If Cells(i, 1).Interior.ColorIndex < 0 And Cells(i, 1) <> "" And Cells(i, 2) = "" _
    Or Cells(i, 1).Interior.ColorIndex > 0 And Cells(i + 1, 1) = "" _
    Or Cells(i, 1) & Cells(i + 1, 1) = "" Then Rows(i).Delete
Next
If Cells(1, 1) = "" Then Rows(1).Delete
'Columns(2).ClearContents 'si l'on veut l'effacer
End Sub

Comme je disais il suffit de faire les bons tests.

La macro se déclenche quand on active la feuille.

A+

 

[job75]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Re,

Je joins quand même le fichier, au cas où...

A+

 

[ipotez]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Génial !!!!
Dernier coup de pouce parce que je n'y arrive pas.

Que modifier dans le code pour définir les cellules de la feuille recap qui récupèrent le résultat
(pour l'instant ça déboule à partir de a1, j'ai besoin de les voir arriver en c62)
Merci encore, c'est magnifique !

 

[job75]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Re,

Dans ce cas il ne faut pas copier toute la feuille mais une plage :

Private Sub Worksheet_Activate()
Dim plage As Range, i As Long
Application.ScreenUpdating = False
Set plage = Sheets("SAISIE").Range("A1", Sheets("SAISIE").Range("A" & Rows.Count).End(xlUp))
Range("C62:D" & Rows.Count).Clear 'effacement préalable
plage.Resize(, 2).Copy [C62] 'copie de la plage
For i = 61 + plage.Count To 62 Step -1
  If Cells(i, 3).Interior.ColorIndex < 0 And Cells(i, 3) <> "" And Cells(i, 4) = "" _
    Or Cells(i, 3).Interior.ColorIndex > 0 And Cells(i + 1, 3) = "" _
    Or Cells(i, 3) & Cells(i + 1, 3) = "" Then Rows(i).Delete
Next
If [C62] = "" Then Rows(1).Delete
'[D62].Resize(plage.Count).ClearContents 'si l'on veut effacer les "x"
End Sub

A+

 

[James007]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Re,

En l'absence de Job75 ... son code :

Private Sub Worksheet_Activate()
Dim i As Long
Application.ScreenUpdating = False
Columns(3).ClearContents
Sheets("SAISIE").Range("A1:B50").Copy Cells(62, 3)
For i = Range("C" & Rows.Count).End(xlUp).Row To 61 Step -1
  If Cells(i, 3).Interior.ColorIndex < 0 And Cells(i, 3) <> "" And Cells(i, 4) = "" _
    Or Cells(i, 3).Interior.ColorIndex > 0 And Cells(i + 1, 3) = "" _
    Or Cells(i, 3) & Cells(i + 1, 3) = "" Then Rows(i).Delete
Next
Application.ScreenUpdating = True
End Sub

A +


Edit : Salut Job75 ...

 

[job75]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Re,

Pas le temps d'étudier la proposition de James, mais j'avais fait une petite erreur à la fin.

Au lieu de :

If [C62] = "" Then Rows(1).Delete

écrire bien sûr :

If [C62] = "" Then Rows(62).Delete

A+

 

[ipotez]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Merci les gars c'est excellent !

Tout fonctionne à merveille.

Par contre je fais le relou une dernière fois, est il possible de gérer une dernière contrainte :
Lorsque les données déboulent sur la feuille récap, serait il possible que cela pousse vers le bas les informations saisies en ligne 70 au lieu des les supprimer.

Par exemple si le résultat donne 3 lignes, serait il possible qu'elle se décalent en ligne 73, et qu'elle reprenne leur position si il n'y a pas de valeur.

Merci encore pour vos compétences ! C'est nickel !

 

[ipotez]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

I send an SOS to the world

 

[job75]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Bonjour ipotez, le forum,

Ready ? Let's go :

Private Sub Worksheet_Activate()
Dim plage As Range, i As Long
Application.ScreenUpdating = False
With Sheets("SAISIE")
  Set plage = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
End With
On Error Resume Next
[Zone].Delete 'suppression préalable
On Error GoTo 0
plage.EntireRow.Copy 'copie de la plage
[62:62].Insert 'insertion de lignes
Me.Names.Add "Zone", [62:62].Resize(plage.Count) 'mémorisation dans un nom
[Zone].Resize(, 2).Cut [C62]
For i = 61 + plage.Count To 62 Step -1
  If Cells(i, 3).Interior.ColorIndex < 0 And Cells(i, 3) <> "" And Cells(i, 4) = "" _
    Or Cells(i, 3).Interior.ColorIndex > 0 And Cells(i + 1, 3) = "" _
    Or Cells(i, 3) & Cells(i + 1, 3) = "" Then Rows(i).Delete
Next
If [C62] = "" Then Rows(62).Delete
'[D62].Resize(plage.Count).ClearContents 'si l'on veut effacer les "x"
End Sub

La macro insère d'abord des lignes qu'elle mémorise dans un nom défini sur la feuille.

A+

 

[job75]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Re,

Ah oui, s'il n'y a pas de valeurs avec "x", la cellule à maintenir passe de C70 à C69...

Alors il faut écrire à la fin :

If [C62] = "" And [C63] <> "" Then Rows(62).Delete

Fichier (4).

A+

 

[job75]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Re,

Et il faut aussi penser à modifier la dernière ligne de code (facultative) :

On Error Resume Next 'si la plage Zone a été supprimée
[Zone].Columns(4).ClearContents 'si l'on veut effacer les "x" en colonne D

Fichier (5).

A+

 

[ipotez]

Re : Faire apparaître une liste d'éléments s'ils sont cochés

Just perfect !
Merci beaucoup à toi et à James.
Bonne année et longue vie a xldld