XL 2010 date récente

[polyteis]

Bonjour
je vous adresse le fichier en pj , qui est plus complet que la fois précédente.
La problématique :
A partir d'un tableau dans l'onglet table, j'aimerai dispose d'une maco qui me donne ce que j'ai appellé résultat attendu.
à savoir
pour une opération donnée (op_numope), ne voir apparaitre que l'opération ayant la "Phase_cal_date_fin_reel" la plus récente et bien tous les éléments composant cette même ligne

exemple
456124​	1-3-RNS-005	ACTIVE	APPROB FDES	JALON	09/06/2020​
456124​	1-3-RNS-005	ACTIVE	Appro FOD	JALON	29/10/2019​
resultat attendu
456124​	1-3-RNS-005	ACTIVE	APPROB FDES	JALON	09/06/2020​

Ce tableau peut comporter beaucoup de ligne ( pas loin de 2000)

merci pour vos réponses

 

[Hasco]

Bonjour,

Voir la solution powerquery (tableau vert dans feuille Table)

P.S. hier vous aviez une version 2016 aujourd'hui 2010 ?

Cordialement

 

[Rouge]

Bonjour,

Si vous n'avez pas Power Query

Option Explicit

Sub Date_recente()
    Dim DerLig_f1 As Long, DerLig_f2 As Long, i As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Application.ScreenUpdating = False
    Set f1 = Sheets("table")
    Set f2 = Sheets("ORIGINAL ET ATTENDU")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = DerLig_f1 + 3
    
    f2.Cells.ClearContents
    'Copie de la feuille "Table" vers feuille "ORIGINAL ET ATTENDU"
    f1.Range("A1:F" & DerLig_f1).Copy f2.Range("A4")
    
    'Tri par Opr_numope et Phase_cal_date_fin_reel (ordre descendant)
    f2.Select
    ActiveWorkbook.Worksheets("ORIGINAL ET ATTENDU").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ORIGINAL ET ATTENDU").Sort.SortFields.Add Key:=Range("A5:A" & DerLig_f2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("ORIGINAL ET ATTENDU").Sort.SortFields.Add Key:=Range("F5:F" & DerLig_f2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("ORIGINAL ET ATTENDU").Sort
        .SetRange Range("A4:F" & DerLig_f2)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'on ne conserve que les dates les plus récentes
    For i = DerLig_f2 To 5 Step -1
        If Cells(i, "A") = Cells(i - 1, "A") Then
            Rows(i).EntireRow.Delete
        End If
    Next i
    
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

 

[polyteis]

Bonjour,

Voir la solution powerquery (tableau vert dans feuille Table)

P.S. hier vous aviez une version 2016 aujourd'hui 2010 ?

Cordialement

bonjour,
la raison est fort simple, à mon domicile je suis dispose d'excel 2010, au travail excel 2016.
Ne connaissant pas power query, je me suis dit, qu'il vaut mieux chercher une solution en excel 10, qui pourra être jouée sur une version 2016.

cordialement
et encore merci pour vos collaborations

 

[polyteis]

Bonjour,

Si vous n'avez pas Power Query

Option Explicit

Sub Date_recente()
    Dim DerLig_f1 As Long, DerLig_f2 As Long, i As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Application.ScreenUpdating = False
    Set f1 = Sheets("table")
    Set f2 = Sheets("ORIGINAL ET ATTENDU")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = DerLig_f1 + 3
   
    f2.Cells.ClearContents
    'Copie de la feuille "Table" vers feuille "ORIGINAL ET ATTENDU"
    f1.Range("A1:F" & DerLig_f1).Copy f2.Range("A4")
   
    'Tri par Opr_numope et Phase_cal_date_fin_reel (ordre descendant)
    f2.Select
    ActiveWorkbook.Worksheets("ORIGINAL ET ATTENDU").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ORIGINAL ET ATTENDU").Sort.SortFields.Add Key:=Range("A5:A" & DerLig_f2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("ORIGINAL ET ATTENDU").Sort.SortFields.Add Key:=Range("F5:F" & DerLig_f2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("ORIGINAL ET ATTENDU").Sort
        .SetRange Range("A4:F" & DerLig_f2)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    'on ne conserve que les dates les plus récentes
    For i = DerLig_f2 To 5 Step -1
        If Cells(i, "A") = Cells(i - 1, "A") Then
            Rows(i).EntireRow.Delete
        End If
    Next i
   
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

bonjour
merci pour cette macro,
cordialement

 

[polyteis]

Bonjour,

Voir la solution powerquery (tableau vert dans feuille Table)

P.S. hier vous aviez une version 2016 aujourd'hui 2010 ?

Cordialement

re bonjour,

ce power query semble puissant, je vais devoir chercher des tutos pour comprendre le fonctionnement
encore merci