XL 2010 date récente

polyteis

XLDnaute Junior
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-005ACTIVEAPPROB FDESJALON
09/06/2020​
456124​
1-3-RNS-005ACTIVEAppro FODJALON
29/10/2019​
resultat attendu
456124​
1-3-RNS-005ACTIVEAPPROB FDESJALON
09/06/2020​

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

merci pour vos réponses
 

Fichiers joints

Rouge

XLDnaute Junior
Bonjour,

Si vous n'avez pas Power Query
VB:
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
 

Fichiers joints

polyteis

XLDnaute Junior
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

XLDnaute Junior
Bonjour,

Si vous n'avez pas Power Query
VB:
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
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas