XL 2019 traiter liste de choix multiples

  • Initiateur de la discussion Initiateur de la discussion serras
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

serras

XLDnaute Occasionnel
Bonjour,

(et tous mes vœux pour cette nouvelle année)

Je cherche un moyen d'exploiter en automatique des données d'inscription renseignées de manières individuelles qui peuvent viser tous les départements.

Le fichier exemple en PJ montre plus précisément l'objectif : 200 intervenants s'inscrivent sur la feuille "liste" via des menus déroulants (de colonne C à CZ) selon deux catégories (les départements sans contrainte de date et ceux avec). Pour info les noms et adresses mails sont évidemment fictifs

Et sur la feuille "recherche" le gestionnaire pourra choisir dans la liste en B1 un département et le fichier lui donnera la liste des intervenants qui se sont positionnés sur ce département (en distinguant ceux avec contrainte de date et ceux sans contrainte de date).

Merci d’avance pour votre aide dans la réalisation de cet outil.

Cordialement,
 

Pièces jointes

Bonjour

Ton fichier est contraire aux RGPD.. il contient des infos perso (adresses mails)
par sur que tes intervenants apprécient d'être la cible de spams ou autre parce que leur adresse mail a été diffusée ici..
supprime ton fichier, et reposte le avec des données bidons
 
Bonjour

Ton fichier est contraire aux RGPD.. il contient des infos perso (adresses mails)
par sur que tes intervenants apprécient d'être la cible de spams ou autre parce que leur adresse mail a été diffusée ici..
supprime ton fichier, et reposte le avec des données bidons
Toutes mes excuses.. j'ai lu trop vite et n'avais noté cette précision
VB:
(les départements sans contrainte de date et ceux avec). Pour info les noms et adresses mails sont évidemment fictifs
 
merci pour ce retour.

A l'usage je vois que la restitution ne fonctionne pas à 100 %.

Avec quelques formules je peux comprendre le cheminement mais en macro impossible

Pour l'Aisne les deux "sans contrainte date" ressortent bien mais les 2 avec ne sont pas les bons. NICLOUS semble correspondre à NICHAMP dans la liste; mais je ne trouve pas de NICLOUS dans ma liste fictive des des 200 intervenants. Cette erreur de cohérence entre les noms se retrouve à chaque fois sur les tests que je fais (autre exemple : MEDHIOU inconnu = MECLAIN dans la liste des 200)

Cela vient probablement de mon fichier de travail (sur lequel j'avais collé une liste de 500 faux noms pour en afficher 1 sur 2 dans les cellules fusionnées)

Désolé pour cette erreur, que mon niveau excel m'empêche de corriger moi même. Je vous fais suivre un fichier 2 de travail, propre cette fois.

Encore merci pour votre aide
 

Pièces jointes

1) j'ai corrigé la macro: manquait une opération de "recopie" du nom sur deux lignes
2) j'ai ajouté des commentaires pour expliquer le code

VB:
Sub Filtrer()
'Déclaration de deux dictionnaires qui contiendront les noms
Dim DicoSansContrainte As Object
Dim DicoAvecContrainte As Object

Dim TabData() As Variant 'déclaration d'un tablo VBA pour y mettre toute la feuille "Liste"

'création des dictionnaires
Set DicoSansContrainte = CreateObject("scripting.dictionary")
Set DicoAvecContrainte = CreateObject("scripting.dictionary")

With Sheets("Liste") 'avec la feuille Liste
    'on détecte la zone complète qui contient des noms
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne NON vide de la colonne A
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 'dernière colonne NON vide de la ligne 1
    TabData = .Range("A2").Resize(LastLine - 1, LastCol).Value 'on met toute la zone détectée dans le tablo VBA
    'du fait des cellules fusionnées sur 2 lignes, la seconde ligne est "normalement" vide==> on recopie chaque nom sur 2 lignes
    For i = LBound(TabData, 1) To UBound(TabData, 1) 'pour chaque ligne du tablo VBA
        If TabData(i, 1) = "" Then TabData(i, 1) = TabData(i - 1, 1)
    Next i
End With

With Sheets("Recherche") 'avec la feuille Recherche
    .UsedRange.Offset(3).Clear 'on efface tout sauf les 3 premières lignes
    Département = .Range("B1") 'on récupère le département sélectionné en B1
    
    For i = LBound(TabData, 1) To UBound(TabData, 1) 'pour chaque ligne du tablo VBA
        For j = 4 To UBound(TabData, 2) 'pour chaque colonne (à partir de la colonne 4 = 1er choix)
            If TabData(i, j) = Département Then 'si le choix correspond au département
                clé = TabData(i, 1) 'on créé une clé avec le nom (en colonne 1)
                NomDico = IIf(InStr(1, TabData(i, 3), "sans") <> 0, "Sans", "Avec") 'on choisit le dictionnaire à utiliser selon si on trouve le mot "SANS" dans la colonne C
                If NomDico = "Sans" Then 'si on est sur le dico SANS
                    If Not DicoSansContrainte.exists(clé) Then 'on ajoute le nom dans le dico
                        DicoSansContrainte.Add clé, 1
                    End If
                Else 'on sur le dico "AVEC"
                    If Not DicoAvecContrainte.exists(clé) Then
                        DicoAvecContrainte.Add clé, i 'on ajoute le nom dans le dico
                    End If
                End If
            End If
        Next j
    Next i
    'on colle les résultats dans la feuille
    .Range("A4").Resize(DicoSansContrainte.Count, 1) = Application.WorksheetFunction.Transpose(DicoSansContrainte.keys)
    .Range("B4").Resize(DicoAvecContrainte.Count, 1) = Application.WorksheetFunction.Transpose(DicoAvecContrainte.keys)

End With
'on libère la mémoire
Set DicoSansContrainte = Nothing
Set DicoAvecContrainte = Nothing

End Sub

par contre.. un truc que je n'explique pas...
dans ton second fichier, (avec les noms "Pierre Test1 2 3 ....) ca fonctionne bien
quand je boucle le tableau vba sur la colonne A (pour recopier les noms), la deuxième ligne est bien vide. ==> la recopie fonctionnre bien

MAIS sur ton fichier initial,
la meme boucle ne donne pas le résultat puisque la deuxième ligne n'est PAS vide... elle contient un nom qui vient de ne je sais ou??
Comment est généré ton fichier??
 
dans le second fichier j'ai supprimé les colonnes A et B pour en recréer de nouvelles. Les doubles noms venaient d'un copier / coller sur des cellules fusionnées (une sur deux)

pouvez vous me faire votre V2 à partir de ce fichier corrigé. merci d'avance pour votre aide précieuse
 
il te suffit de remplacer le code existant par celui que je t'ai fournir dans le post 6

1) ouvrir l'éditeur VBA: Alt+F11
2) à gauche dans l'explorateur du projet
double clic sur le module 1
remplacer tout le code par le nouveau

3) le fichier enregistré a pour extension .xlsm (m comme macro)
 
merci pour ton aide précieuse.

le résultat est parfait
Bonjour, avec la mise a zéro du fichier (pour enlever les exemples) j'ai une erreur de fonctionnement. Toutes les infos ne sont pas reprises dans la feuille RECHERCHE.

J'ai ouvert l'éditeur VBA mais je ne vois pas

Si tu peux m'aider, ce serait très gentil. Merci
 

Pièces jointes

Bonjour, avec la mise a zéro du fichier (pour enlever les exemples) j'ai une erreur de fonctionnement. Toutes les infos ne sont pas reprises dans la feuille RECHERCHE.

J'ai ouvert l'éditeur VBA mais je ne vois pas

Si tu peux m'aider, ce serait très gentil. Merci
pour être plus précis, j'ai identifié ce qui génère une erreur : la dernière ligne saisie n'est pas prise en compte dans la restitution de la page RECHERCHE

Pour faire fonctionner : j'enregistre un faux intervenant sur ligne 501 avec un département d'intervention. Il n'est pas pris en compte mais permet de faire fonctionner le reste

Si tu peux me proposer une solution moins bricolage je suis preneur
 
bonjour

remplace par ce code
VB:
Sub Filtrer()
'Déclaration de deux dictionnaires qui contiendront les noms
Dim DicoSansContrainte As Object
Dim DicoAvecContrainte As Object

Dim TabData() As Variant 'déclaration d'un tablo VBA pour y mettre toute la feuille "Liste"

'création des dictionnaires
Set DicoSansContrainte = CreateObject("scripting.dictionary")
Set DicoAvecContrainte = CreateObject("scripting.dictionary")

With Sheets("Liste") 'avec la feuille Liste
    'on détecte la zone complète qui contient des noms
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'dernière ligne NON vide de la colonne A
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 'dernière colonne NON vide de la ligne 1
    TabData = .Range("A2").Resize(LastLine - 1, LastCol).Value 'on met toute la zone détectée dans le tablo VBA
    'du fait des cellules fusionnées sur 2 lignes, la seconde ligne est "normalement" vide==> on recopie chaque nom sur 2 lignes
    For i = LBound(TabData, 1) To UBound(TabData, 1) 'pour chaque ligne du tablo VBA
        If TabData(i, 1) = "" Then TabData(i, 1) = TabData(i - 1, 1)
    Next i
End With

With Sheets("Recherche") 'avec la feuille Recherche
    .UsedRange.Offset(3).Clear 'on efface tout sauf les 3 premières lignes
    Département = .Range("B1") 'on récupère le département sélectionné en B1
    
    For i = LBound(TabData, 1) To UBound(TabData, 1) 'pour chaque ligne du tablo VBA
        For j = 4 To UBound(TabData, 2) 'pour chaque colonne (à partir de la colonne 4 = 1er choix)
            If TabData(i, j) = Département Then 'si le choix correspond au département
                clé = TabData(i, 1) 'on créé une clé avec le nom (en colonne 1)
                NomDico = IIf(InStr(1, TabData(i, 3), "sans") <> 0, "Sans", "Avec") 'on choisit le dictionnaire à utiliser selon si on trouve le mot "SANS" dans la colonne C
                If NomDico = "Sans" Then 'si on est sur le dico SANS
                    If Not DicoSansContrainte.exists(clé) Then 'on ajoute le nom dans le dico
                        DicoSansContrainte.Add clé, 1
                    End If
                Else 'on sur le dico "AVEC"
                    If Not DicoAvecContrainte.exists(clé) Then
                        DicoAvecContrainte.Add clé, i 'on ajoute le nom dans le dico
                    End If
                End If
            End If
        Next j
    Next i
    'on colle les résultats dans la feuille si il y a quelque chose à copier
    If DicoSansContrainte.Count <> 0 Then .Range("A4").Resize(DicoSansContrainte.Count, 1) = Application.WorksheetFunction.Transpose(DicoSansContrainte.keys)
    If DicoAvecContrainte.Count <> 0 Then .Range("B4").Resize(DicoAvecContrainte.Count, 1) = Application.WorksheetFunction.Transpose(DicoAvecContrainte.keys)

End With
'on libère la mémoire
Set DicoSansContrainte = Nothing
Set DicoAvecContrainte = Nothing

End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour