XL 2016 lister des noms présent dans cinq colonnes

[eduraiss]

Bonjour le forum

Voila j'ai 5 colonne qui représente les jours de la semaine

En dessous chaque jour une liste de noms

j'aimerais lister dans une colonne résultat les noms qui sont présent dans les cinq colonnes

Je joins un fichier
Merci à vous

 

[Dudu2]

Bonjour,
Est-ce que tu as la possibilité d'avoir liste de tous les noms dans une colonne ?

 

[Hasco]

Bonjour,

Dans le fichier joint, une solution par Power Query (Données / A partir d'un tableau ou d'une plage)

cordialement

[Edition] Fichier rechargé, une erreur traînait.

 

[eduraiss]

Re bonjour
Bonjour Dudu2
oui il est possible d'avoir la liste dans une même colonne
Bonjour Roblochon
Impossible d'ouvrir le fichier
Oops : nous avons rencontré des problèmes.
La page demandée n'a pu être trouvée.

 

[Hasco]

Re,

Bonjour Roblochon
Impossible d'ouvrir le fichier

Certainement, j'étais en train de rééditer mon message précédent et sa pièce jointe lorsque vous avez essayé de la télécharger. Recommencez. Si cela échoue encore, je reposterai.

 

[eduraiss]

Re
oui en effet j'ai pu ouvrir

Je vous remercie Roblochon, mais je ne saurais pas utiliser cette méthode

je ne l'ai jamais utilisé et pour l'adapter a mon fichier , je ne pense pas y arrivé
Désolé

 

[mapomme]

Bonsoir à tous 😉 ,

Avec une macro VBA.
Code à mettre dans le module de la feuille Feuil1
Ce code s'active quand une cellule des colonnes K à O est modifiée.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xcol, n&, dico1, dico2, t, t0, i&, DeuxPlus As Boolean, xkey

   If Intersect(Columns("k:o"), Target) Is Nothing Then Exit Sub
   For Each xcol In Columns("k:o")
      If Not DeuxPlus Then
         n = xcol.Cells(Rows.Count, 1).End(xlUp).Row
         Set dico1 = CreateObject("scripting.dictionary")
         t = xcol.Resize(n)
         For i = 2 To UBound(t): dico1(t(i, 1)) = "": Next
         DeuxPlus = True
      Else
         n = xcol.Cells(Rows.Count, 1).End(xlUp).Row
         Set dico2 = CreateObject("scripting.dictionary")
         t = xcol.Resize(n)
         For i = 2 To UBound(t): dico2(t(i, 1)) = "": Next
         For Each xkey In dico1.keys
            If Not dico2.exists(xkey) Then dico1.Remove xkey
         Next xkey
      End If
   Next xcol
   Columns("p").ClearContents
   Range("p1") = "RESULTAT"
   If dico1.Count > 0 Then Range("p2").Resize(dico1.Count) = Application.Transpose(dico1.keys)
End Sub

 

[eduraiss]

Re
Bonjour mapomme

je test et je reviens vers vous
Merci

 

[Dudu2]

Le plus simple c'est de faire un Macro.
Toutefois, si c'est interdit, une solution avec formules, pas évidente mais fonctionnelle.
C'est peut-être possible d'éviter 1 colonne "de travail", mais faudrait du temps de recherche (pour moi).

 

[mapomme]

Bonjour @Dudu2 😉

C'est peut-être possible d'éviter 1 colonne "de travail"

Une colonne auxiliaire n'est pas forcément une mauvaise solution selon moi.
Ça peut éviter des formules matricielles toujours coûteuses en ressources, simplifier des formules. et les rendre plus intelligibles.

 

[Dudu2]

Après les évènements, mais je laisse quand même une option de macro à activer soit sur un bouton, soit sur un évènement comme l'a fait mapomme.

Option Explicit

Private Const NbLigTitre = 1
Private Const ColonneNoms = "K,L,M,N,O"
Private Const ColonneResultat = "P"

Sub NomsCommuns()
    Dim tNoms() As Variant
    Dim tCommuns() As Variant
    Dim tCols() As String
    Dim Col As Variant
    Dim Nom As Variant
    Dim i As Integer
    Dim k As Integer
 
    'Initialisations
    tCols = Split(ColonneNoms, ",")
    ReDim tNoms(0 To 0)
    ReDim tCommuns(0 To 0)
 
    'Efface le résultat précédent
    k = ActiveSheet.Range(ColonneResultat & Rows.Count).End(xlUp).Row
    If k > NbLigTitre Then ActiveSheet.Range(ColonneResultat & NbLigTitre + 1 & ":" & ColonneResultat & k).ClearContents
     
    'Tous les noms en table tNoms()
    For Each Col In tCols
        k = ActiveSheet.Range(Col & Rows.Count).End(xlUp).Row
        For i = NbLigTitre + 1 To k
            For k = 1 To UBound(tNoms)
                If Trim(ActiveSheet.Range(Col & i).Value) = tNoms(k) Then Exit For
            Next k
            If k > UBound(tNoms) Then
                ReDim Preserve tNoms(0 To UBound(tNoms) + 1)
                tNoms(UBound(tNoms)) = Trim(ActiveSheet.Range(Col & i).Value)
            End If
        Next i
    Next Col
 
    'Liste des communs
    For Each Nom In tNoms
        For Each Col In tCols
            k = ActiveSheet.Range(Col & Rows.Count).End(xlUp).Row
            For i = NbLigTitre + 1 To k
                If Trim(ActiveSheet.Range(Col & i).Value) = Nom Then Exit For
            Next i
            If i > k Then Exit For
        Next Col
     
        If IsEmpty(Col) Then
            ReDim Preserve tCommuns(0 To UBound(tCommuns) + 1)
            tCommuns(UBound(tCommuns)) = Nom
            'MsgBox Nom
        End If
    Next Nom
 
    'Affectation du résultat
    Application.ScreenUpdating = False
    For i = 1 To UBound(tCommuns)
        ActiveSheet.Range(ColonneResultat & NbLigTitre + i).Value = tCommuns(i)
    Next i
    Application.ScreenUpdating = True

End Sub

Edit: s'il fallait vraiment accélérer l'exécution, on pourrait mettre les Values de la feuille en tableau

 

[eduraiss]

Re bonjour
ça marche nickel
Par contre je suis parti sur 5 colonnes, et je m’aperçois il y a des jours on on ne travaille pas on peut avoir des semaine ou il y aura 4 jours avec des noms voir défois 3
Désolé de la mauvaise info du dèpart
Sinon sur 5 jour c'est pafait les deux codes fonctionne parfaitement

Merci a vous

 

[Dudu2]

Et ... ?
Quand le jour n'est pas travaillé, la colonne est vide ?

 

[eduraiss]

oui elle est vide sauf le nom du jour

 

[mapomme]

Re,
Bonjour @zebanx 🙂,

Par contre je suis parti sur 5 colonnes, et je m’aperçois il y a des jours on on ne travaille pas on peut avoir des semaine ou il y aura 4 jours avec des noms voir défois 3

Voir la version v2:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xcol, n&, dico1, dico2, t, t0, i&, DeuxPlus As Boolean, xkey
 
   If Intersect(Columns("k:o"), Target) Is Nothing Then Exit Sub
   For Each xcol In Columns("k:o")
      If Not DeuxPlus Then
         n = xcol.Cells(Rows.Count, 1).End(xlUp).Row
         If n > 1 Then
            Set dico1 = CreateObject("scripting.dictionary")
            t = xcol.Resize(n)
            For i = 2 To UBound(t): dico1(t(i, 1)) = "": Next
            DeuxPlus = True
         End If
      Else
         n = xcol.Cells(Rows.Count, 1).End(xlUp).Row
         If n > 1 Then
            Set dico2 = CreateObject("scripting.dictionary")
            t = xcol.Resize(n)
            For i = 2 To UBound(t): dico2(t(i, 1)) = "": Next
            For Each xkey In dico1.keys
               If Not dico2.exists(xkey) Then dico1.Remove xkey
            Next xkey
         End If
      End If
   Next xcol
   Columns("p").ClearContents
   Range("p1") = "RESULTAT"
   If dico1.Count > 0 Then Range("p2").Resize(dico1.Count) = Application.Transpose(dico1.keys)
End Sub