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

Jacques SPAGNOL

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

Pièces jointes

  • ExtractValeurDateSPL.xlsx
    18.7 KB · Affichages: 5
Solution
Bonsoir,
"Le mieux est l'ennemi du bien."
Et moi qui pensais que mettre tous les codes journée vous simplifierait la vie. :rolleyes:
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

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

Pièces jointes

  • ExtractValeurDateSPL (V2).xlsm
    84.1 KB · Affichages: 1
Dernière édition:

R@chid

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

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

XLDnaute Barbatruc
Supporter XLD
Bonsoir,
"Le mieux est l'ennemi du bien."
Et moi qui pensais que mettre tous les codes journée vous simplifierait la vie. :rolleyes:
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.
 

Pièces jointes

  • ExtractValeurDateSPL (V4).xlsm
    85.5 KB · Affichages: 2
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 948
Membres
101 850
dernier inscrit
Danigra