XL 2016 Listbox en fonction d'une date se produisant dans l'année

[ced91300]

Bonjour à tous,

j'ai une Listbox qui recherche et affiche les lignes d'une feuille dont les dates en colonne D se produisent dans l'année (le vba fonctionne).
en revanche, j'ai besoin en + la même chose sur 3 autres ListBox dont :
une ListeBox pour le mois de l'année en cours
une ListeBox se produisant dans les 30 jour à venir
une ListeBox des dates dépassées

Mon fichier joint .
merci beaucoup
Cordialement
Cédric

 

[Gégé-45550]

Bonjour à tous,

j'ai une Listbox qui recherche et affiche les lignes d'une feuille dont les dates en colonne D se produisent dans l'année (le vba fonctionne).
en revanche, j'ai besoin en + la même chose sur 3 autres ListBox dont :
une ListeBox pour le mois de l'année en cours
une ListeBox se produisant dans les 30 jour à venir
une ListeBox des dates dépassées

Mon fichier joint .
merci beaucoup
Cordialement
Cédric

Bonsoir,
Comme ça ?
Cordialement,

 

[job75]

Bonjour ced91300, Gégé-45550,

Une autre solution qui n'introduit pas de lignes vides dans les ListBox :

Private Sub UserForm_Initialize()
Dim tablo, tabannee(), tabmois(), tabjours(), tabpasses(), i&, dat, n1&, j%, n2&, n3&, n4&
    tablo = [totoH] 'tableau structuré
    For i = 1 To UBound(tablo)
        dat = tablo(i, 4)
        If IsDate(dat) Then
            dat = CDate(dat)
            If Year(dat) = Year(Date) Then
                ReDim Preserve tabannee(3, n1) 'base 0
                For j = 0 To 3: tabannee(j, n1) = tablo(i, j + 1): Next j
                n1 = n1 + 1
            End If
            If Year(dat) = Year(Date) And Month(dat) = Month(Date) Then
                ReDim Preserve tabmois(3, n2) 'base 0
                For j = 0 To 3: tabmois(j, n2) = tablo(i, j + 1): Next j
                n2 = n2 + 1
            End If
            If dat >= Date And dat <= Date + 30 Then
                ReDim Preserve tabjours(3, n3) 'base 0
                For j = 0 To 3: tabjours(j, n3) = tablo(i, j + 1): Next j
                n3 = n3 + 1
            End If
            If dat < Date Then
                ReDim Preserve tabpasses(3, n4) 'base 0
                For j = 0 To 3: tabpasses(j, n4) = tablo(i, j + 1): Next j
                n4 = n4 + 1
            End If
        End If
    Next i
    '---restitutions---
    If n1 = 1 Then
        annee.AddItem ""
        For j = 0 To 3: annee.List(0, j) = tabannee(j, 0): Next j
    Else
        annee.List = Application.Transpose(tabannee) 'Transpose est limitée à 65536 lignes
    End If
    If n2 = 1 Then
        mois.AddItem ""
        For j = 0 To 3: mois.List(0, j) = tabmois(j, 0): Next j
    Else
        mois.List = Application.Transpose(tabmois)
    End If
    If n3 = 1 Then
        jours.AddItem ""
        For j = 0 To 3: jours.List(0, j) = tabjours(j, 0): Next j
    Else
        jours.List = Application.Transpose(tabjours)
    End If
    If n4 = 1 Then
        passes.AddItem ""
        For j = 0 To 3: passes.List(0, j) = tabpasses(j, 0): Next j
    Else
        passes.List = Application.Transpose(tabpasses)
    End If
End Sub

A+

 

[ced91300]

Bonsoir,
Comme ça ?
Cordialement,

Bonsoir Gégé

Oui impec, merci bcp de ton aide et pour le temps consacré à m'aider.
Cordialement
Cédric

 

[ced91300]

Bonjour ced91300, Gégé-45550,

Une autre solution qui n'introduit pas de lignes vides dans les ListBox :

Private Sub UserForm_Initialize()
Dim tablo, tabannee(), tabmois(), tabjours(), tabpasses(), i&, dat, n1&, j%, n2&, n3&, n4&
    tablo = [totoH] 'tableau structuré
    For i = 1 To UBound(tablo)
        dat = tablo(i, 4)
        If IsDate(dat) Then
            dat = CDate(dat)
            If Year(dat) = Year(Date) Then
                ReDim Preserve tabannee(3, n1) 'base 0
                For j = 0 To 3: tabannee(j, n1) = tablo(i, j + 1): Next j
                n1 = n1 + 1
            End If
            If Year(dat) = Year(Date) And Month(dat) = Month(Date) Then
                ReDim Preserve tabmois(3, n2) 'base 0
                For j = 0 To 3: tabmois(j, n2) = tablo(i, j + 1): Next j
                n2 = n2 + 1
            End If
            If dat >= Date And dat <= Date + 30 Then
                ReDim Preserve tabjours(3, n3) 'base 0
                For j = 0 To 3: tabjours(j, n3) = tablo(i, j + 1): Next j
                n3 = n3 + 1
            End If
            If dat < Date Then
                ReDim Preserve tabpasses(3, n4) 'base 0
                For j = 0 To 3: tabpasses(j, n4) = tablo(i, j + 1): Next j
                n4 = n4 + 1
            End If
        End If
    Next i
    '---restitutions---
    If n1 = 1 Then
        annee.AddItem ""
        For j = 0 To 3: annee.List(0, j) = tabannee(j, 0): Next j
    Else
        annee.List = Application.Transpose(tabannee) 'Transpose est limitée à 65536 lignes
    End If
    If n2 = 1 Then
        mois.AddItem ""
        For j = 0 To 3: mois.List(0, j) = tabmois(j, 0): Next j
    Else
        mois.List = Application.Transpose(tabmois)
    End If
    If n3 = 1 Then
        jours.AddItem ""
        For j = 0 To 3: jours.List(0, j) = tabjours(j, 0): Next j
    Else
        jours.List = Application.Transpose(tabjours)
    End If
    If n4 = 1 Then
        passes.AddItem ""
        For j = 0 To 3: passes.List(0, j) = tabpasses(j, 0): Next j
    Else
        passes.List = Application.Transpose(tabpasses)
    End If
End Sub

A+

Bonsoir Job75

Merci à toi également Job75, les deux solutions sont nickel pour moi
Cordialement
Cédric

 

[job75]

Bonjour ced91300, le forum,

@ChTi160 sur un autre fil m'a rappelé l'utilisation de la propriété .Column des ListBox, merci.

Ici c'est bien plus simple :

    '---restitutions---
    annee.Column = tabannee
    mois.Column = tabmois
    jours.Column = tabjours
    passes.Column = tabpasses

A+