Recherche des dates au plus tard avec critère

Bonsoir le forum!

Alors voila, le problème c'est que mon code s’exécute et donne le résultat que je souhaite MAIS débogue à la fin....

J'ai dans ma première colonne une liste de lot qui peuvent apparaître plusieurs fois. Dans la deuxième colonne, il y a des dates associées aux lots. De ce fait, les lots ont donc plusieurs dates différentes. Et je veux récupérer la date la tard pour chaque lot.

En fait, je veux faire l'équivalent d'un formule "MAX" mais je préfère passer en vba car à terme, le fichier sera trop lourd pour supporter des formules.

Je sais qu'il est possible de le réaliser en créant un tableau à 2 dimensions pour mémoriser les valeurs mais je n'arrive pas à le faire...

J'ai donc "bidouiller" le code suivant ( bidouiller car les meilleurs d'entre vous vont surement pleurer en voyant mon code de jeune novice autodidacte qui patauge )...

Sub date_la_plus_tard()

 ''''' calcul de la date la plus tard pour chaque lot

Dim Tblmaj As Variant
Dim BoucleA As Long
Dim NblingneMAJ As Long

Dim recherchedate As Variant

NblingneMAJ = Sheets("MAJparMacro").Range("A" & Rows.Count).End(xlUp).Row

Tblmaj = Sheets("MAJparMacro").Range("A1").CurrentRegion

'Classement des dates colonnes B la plus Récente en 1er
Worksheets("MAJparMacro").Select
Worksheets("MAJparMacro").Range("A1:B1").Select
    Selection.AutoFilter
  ActiveWorkbook.Worksheets("MAJparMacro").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("MAJparMacro").AutoFilter.Sort.SortFields.Add Key:= _
        Range("B1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("MAJparMacro").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'Recuperation des lots sans doublons dans la colonne C
Sheets("MAJparMacro").Select
Range("A1:A" & NblingneMAJ).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("C1"), Unique:=True
Range("D1") = "Date la plus tard"

For BoucleA = 2 To UBound(Tblmaj)
            Set recherchedate = Worksheets("MAJparMacro").Range("A1:A" & NblingneMAJ).Cells.Find(What:=Sheets("MAJparMacro").Range("C" & BoucleA), LookAt:=xlWhole)
                Sheets("MAJparMacro").Range("D" & BoucleA) = recherchedate.Offset(0, 1)
Next BoucleA

Sheets("MAJparMacro").Columns("D:D").NumberFormat = "dd/mm/yyyy"

End Sub

Je laisse le fichier pour mieux illustrer la situation.

Un grand merci d'avance à ceux qui me viendront en aide!!

Bonsoir,

Sub ExtractionDateMax()
    Dim Tdm(), m%, n&, i&
    With Worksheets("MAJparMacro")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A2:B" & n).Sort key1:=.Range("A2"), order1:=xlAscending, key2:=.Range("B2"), _
         order2:=xlDescending, Header:=xlNo
        ReDim Tdm(1, 0)
        For i = 2 To n
            If .Cells(i, 1) <> Tdm(0, m) Then
                m = m + 1: ReDim Preserve Tdm(1, m)
                Tdm(0, m) = .Cells(i, 1): Tdm(1, m) = .Cells(i, 2).Value2
            End If
        Next i
    End With
    Tdm(0, 0) = "Lots": Tdm(1, 0) = "Date la plus tard"
    With Worksheets("Résultat")
        .Range("A1").CurrentRegion.ClearContents
        With .Range("A1").Resize(m + 1, 2)
            .Value = WorksheetFunction.Transpose(Tdm)
            .HorizontalAlignment = xlCenter
            .Columns(2).NumberFormat = "dd/mm/yyyy"
        End With
        .Activate
    End With
End Sub

Cordialement.

Bon bah c'est parfait!

J'ai même réussi à l'adapter à un autre de mes problèmes!

Je comprend mieux maintenant comment faire un tableau qui conserve les valeurs!

Merci beaucoup! c'est vraiment top!!!