XL 2016 lister des noms présent dans cinq colonnes

eduraiss

XLDnaute Accro
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
 

Pièces jointes

  • Eric 19.xlsm
    10.3 KB · Affichages: 18

Hasco

XLDnaute Barbatruc
Repose en paix
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.
 

Pièces jointes

  • Eric 19.xlsm
    19.2 KB · Affichages: 11
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
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.
Code:
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
 

Pièces jointes

  • eduraiss- élem communs- v1.xlsm
    17.9 KB · Affichages: 9
Dernière édition:

Dudu2

XLDnaute Barbatruc
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).
 

Pièces jointes

  • Copie de Eric 19-2.xlsx
    11.3 KB · Affichages: 6

Dudu2

XLDnaute Barbatruc
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.

VB:
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
 
Dernière édition:

eduraiss

XLDnaute Accro
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
 

mapomme

XLDnaute Barbatruc
Supporter XLD
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:
VB:
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
 

Pièces jointes

  • eduraiss- élem communs- v2.xlsm
    18.1 KB · Affichages: 6

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T