Extraction de données VBA

Loqman

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

Pièces jointes

  • momosoupe_dates.xlsm
    23.1 KB · Affichages: 8

job75

XLDnaute Barbatruc
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) :
VB:
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+
 

Pièces jointes

  • momosoupe_dates(1).xlsm
    24.2 KB · Affichages: 6

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 794
Membres
101 817
dernier inscrit
carvajal