Extraction de données VBA

[Loqman]

Bonjour le forum!

J'aurais besoin de votre aide svp sur VBA, en effet je n'arrive pas à faire apparaitre les commentaires des dates maximum une fois que j'effectue le test (cf. dossier ci-joint).

Merci d'avance pour votre aide!

Cordialement.

 

[job75]

Bonjour Loqman, bienvenue sur XLD,

Voyez le fichier joint et cette macro dans le code de la feuille "Résultat" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Activate()
Dim dest As Range, tablo, d As Object, i&, x$, s, a, b, c()
Set dest = [A2] '1ère cellule de destination, à adapter
tablo = Feuil1.[A1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    If IsDate(tablo(i, 2)) Then
        x = CStr(tablo(i, 1))
        If d.exists(x) Then
            s = Split(d(x), Chr(1))
            If CDate(tablo(i, 2)) > CDate(s(0)) Then d(x) = tablo(i, 2) & Chr(1) & tablo(i, 3)
        Else
            d(x) = tablo(i, 2) & Chr(1) & tablo(i, 3)
        End If
    End If
Next
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
If d.Count Then
    a = d.keys: b = d.items: ReDim c(UBound(a), 2)
    For i = 0 To UBound(a)
        c(i, 0) = a(i)
        s = Split(b(i), Chr(1))
        c(i, 1) = CDate(s(0))
        c(i, 2) = s(1)
    Next
    dest.Resize(d.Count, 3) = c
End If
dest.Offset(d.Count).Resize(Rows.Count - d.Count - dest.Row + 1, 3).Delete xlUp 'RAZ en dessous
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Elle se déclenche automatiquement quand on active la feuille.

Elle est très rapide car elle utilise le Dictionary et des tableaux VBA.

A+

 

[Loqman]

Merci beaucoup!!!!