XL 2019 lister un certain nombre de date selon un critère

Jacques SPAGNOL · 17 Mars 2023

Bonsoir le forum,
A partir d'une bdd annuelle de travail a l'horizontale, pourvoir extraire sous forme de liste verticale l'ensemble des journées correspondant à un critère ( = un type de journée de travail codifié)
(Codes des journées en ligne 4)

Exemple recherché en (L11) :
comme avec la fonction rechecheX mais qui me renvoyerai la totalité des correspondances trouvées de manière dynamique.

je cherche à obtenir sur au moins trois colonnes et a partir d'une liste déroulante (en B10, D10, F10) ces informations a des fins statistiques.
ci-joint un extrait de la base de données
merci d'avance

sylvanu · 19 Mars 2023

Bonsoir,
"Le mieux est l'ennemi du bien."
Et moi qui pensais que mettre tous les codes journée vous simplifierait la vie.
Une nouvelle PJ où ne sont traités que les 3 codes demandés. C'est encore plu simple.
Soit c'est réactualisé en appuyant sur "Actualiser" ou automatiquement quand on change un des codes journées.

sylvanu · 18 Mars 2023

Bonsoir Jacques, et bienvenu sur XLD,
Un essai en PJ avec cette macro qui liste les codes journée présents et les met par ordre croissant :

VB:

Sub Distribue()
    Dim T, Tcode, DC%, i%, L%, C%
    [B10:Z1000].ClearContents
    Application.ScreenUpdating = False
    DC = Cells(4, Columns.Count).End(xlToLeft).Column
    ReDim Tcode(1 To Application.Max([4:4]))
    T = [A1].CurrentRegion
    For i = 2 To UBound(T, 2)
        If T(4, i) <> "" Then Tcode(T(4, i)) = 1
    Next i
    C = 2
    For i = 1 To UBound(Tcode)
        If Tcode(i) <> "" Then Cells(11, C) = i: C = C + 1
    Next i
    For i = 2 To UBound(T, 2)
        If T(4, i) <> "" Then
            C = Application.Match(T(4, i), [11:11], 0)
            L = 1 + Cells(65000, C).End(xlUp).Row
            Cells(L, C) = T(2, i)
        End If
    Next i
    C = 2
    While Cells(11, C) <> ""
        Cells(10, C) = Application.CountIf(Range(Cells(12, C), Cells(1000, C)), ">0")
        C = C + 1
    Wend
End Sub

R@chid · 18 Mars 2023

Bonsoir,
en L12 :

VB:

=SIERREUR(INDEX(B$2:BF$2;PETITE.VALEUR(SI(B$4:BF$4=L$11;TRANSPOSE(LIGNE(INDIRECT("1:"&COLONNES(B4:BF4)))));LIGNES($12:12)));"")

@ valider par Ctrl+Maj+Entree
@ tirer vers le bas

Cordialement

EDIT : Salut sylvanu

Jacques SPAGNOL · 19 Mars 2023

sylvanu à dit:

Bonsoir Jacques, et bienvenu sur XLD,
Un essai en PJ avec cette macro :

VB:

Sub Distribue()
    Dim T, Tcode, DC%, i%, L%, C%
    [B10:Z1000].ClearContents
    Application.ScreenUpdating = False
    DC = Cells(4, Columns.Count).End(xlToLeft).Column
    ReDim Tcode(1 To Application.Max([4:4]))
    T = [A1].CurrentRegion
    For i = 2 To UBound(T, 2)
        If T(4, i) <> "" Then Tcode(T(4, i)) = 1
    Next i
    C = 2
    For i = 1 To UBound(Tcode)
        If Tcode(i) <> "" Then Cells(11, C) = i: C = C + 1
    Next i
    For i = 2 To UBound(T, 2)
        If T(4, i) <> "" Then
            C = Application.Match(T(4, i), [11:11], 0)
            L = 1 + Cells(65000, C).End(xlUp).Row
            Cells(L, C) = T(2, i)
        End If
    Next i
    C = 2
    While Cells(11, C) <> ""
        Cells(10, C) = Application.CountIf(Range(Cells(12, C), Cells(1000, C)), ">0")
        C = C + 1
    Wend
End Sub

R@chid à dit:
Bonsoir,
en L12 :

VB:

=SIERREUR(INDEX(B$2:BF$2;PETITE.VALEUR(SI(B$4:BF$4=L$11;TRANSPOSE(LIGNE(INDIRECT("1:"&COLONNES(B4:BF4)))));LIGNES($12:12)));"")

@ valider par Ctrl+Maj+Entree
@ tirer vers le bas

Cordialement

EDIT : Salut sylvanu

Merci pour ces retours ultra rapide,
je l'a test en fin W.E et je reviens vers vous
Cdt Jacques

sylvanu à dit:

Bonsoir Jacques, et bienvenu sur XLD,
Un essai en PJ avec cette macro qui liste les codes journée présents et les met par ordre croissant :

VB:

Sub Distribue()
    Dim T, Tcode, DC%, i%, L%, C%
    [B10:Z1000].ClearContents
    Application.ScreenUpdating = False
    DC = Cells(4, Columns.Count).End(xlToLeft).Column
    ReDim Tcode(1 To Application.Max([4:4]))
    T = [A1].CurrentRegion
    For i = 2 To UBound(T, 2)
        If T(4, i) <> "" Then Tcode(T(4, i)) = 1
    Next i
    C = 2
    For i = 1 To UBound(Tcode)
        If Tcode(i) <> "" Then Cells(11, C) = i: C = C + 1
    Next i
    For i = 2 To UBound(T, 2)
        If T(4, i) <> "" Then
            C = Application.Match(T(4, i), [11:11], 0)
            L = 1 + Cells(65000, C).End(xlUp).Row
            Cells(L, C) = T(2, i)
        End If
    Next i
    C = 2
    While Cells(11, C) <> ""
        Cells(10, C) = Application.CountIf(Range(Cells(12, C), Cells(1000, C)), ">0")
        C = C + 1
    Wend
End Sub

bonsoir @sylvanu ta solution me plait particulièrement et me renvoi les résultats attendus (voir me fait faire un bond dans mon projet), mais cette partie je dois conserver la possibilité de choisir les 3 codes de journée qui ne correspond pas toujours à la même combinaisons d'où la toupie en entête de colonne de résultat, et de plus le fichier comporte en fait 23 codes de journée dont un " vide ".

sylvanu · 19 Mars 2023

Bonsoir,
"Le mieux est l'ennemi du bien."
Et moi qui pensais que mettre tous les codes journée vous simplifierait la vie.
Une nouvelle PJ où ne sont traités que les 3 codes demandés. C'est encore plu simple.
Soit c'est réactualisé en appuyant sur "Actualiser" ou automatiquement quand on change un des codes journées.

Jacques SPAGNOL · 19 Mars 2023

R@chid à dit:
Bonsoir,
en L12 :

VB:

=SIERREUR(INDEX(B$2:BF$2;PETITE.VALEUR(SI(B$4:BF$4=L$11;TRANSPOSE(LIGNE(INDIRECT("1:"&COLONNES(B4:BF4)))));LIGNES($12:12)));"")

@ valider par Ctrl+Maj+Entree
@ tirer vers le bas

Cordialement

EDIT : Salut sylvanu

Merci R@chid le code est opérationnel , il me servira dans une autre partie de mon projet.

XL 2019 lister un certain nombre de date selon un critère

Jacques SPAGNOL

XLDnaute Nouveau

Pièces jointes

sylvanu

sylvanu

XLDnaute Barbatruc

Pièces jointes

R@chid

XLDnaute Barbatruc

Jacques SPAGNOL

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

Jacques SPAGNOL

XLDnaute Nouveau

Discussions similaires