Excel : Extraire des données en fonction des dernières dates

Bonjour à tous,

J'ai un gros fichier (qui ressemble à une base de données) que je met à jour régulièrement. (j'en ai mis une partie simplifiée et raccourcie en PJ.

Sur ma base données (onglets saisie des cuveries), j'ai des cuves (numérotées de 1 à 108 --> colonne A). le fichier est trié par date croissante (colonne B). J'aimerai extraire des données volume, brix et désignation (colonnes D, H, I) sur une autre feuille (plan de cuves)afin d'avoir un état de mes cuves à l'instant T.

Le seul soucis est qu'une cuve est remplie et vidée plusieurs fois (donc plusieurs fois le même numéro dans la colonne) et qu'il faut que je sélectionne la cellule correspondante à la dernière date de mise en œuvre.

J'ai essayé avec des recherchesv, index etc .... je n'ai pas trouvé de solution ....

Merci de votre aide.

Cordialement,

22pakal.zip (101.95 Ko)

bonjour,

ça ne me semble pas possible tant que tu auras plusieurs fois la même date pour la même cuve.

ou alors il faut créer une colonne pour indiquer quel est la dernière relève pour chaque jour...

ex: cuve 17 > 7 Avril

Sinon un simple :

=RECHERCHEV(17;Base_de_donnees;9;FAUX)

...suffit, à condition que les dates soient triées en ordre décroissant.

A+

Bonjour le forum,

Résultat en feuil1, n'oublies pas de la créer.

Option Explicit

Sub Cuverie()
Dim a, i As Long, j As Long, txt As String, n As Long
    Application.ScreenUpdating = False
    With Sheets(1).Range("A5").CurrentRegion
        a = Application.Index(.Value, Evaluate("row(1:" & _
                                               .Rows.Count & ")"), Array(1, 2, 4, 8, 9))
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 1)
            txt = a(i, 1)
            If Not .exists(txt) Then
                n = n + 1
                .Item(txt) = n
                For j = 1 To UBound(a, 2)
                    a(n, j) = a(i, j)
                Next
            Else
                If a(.Item(txt), 2) <= a(i, 2) Then
                    For j = 1 To UBound(a, 2)
                        a(.Item(txt), j) = a(i, j)
                    Next
                End If
            End If
        Next
    End With
    With Sheets("Feuil1").Range("A1")
        .CurrentRegion.Clear
        .Cells(1).Resize(n, UBound(a, 2)).Value = a
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders(xlInsideVertical).Weight = xlThin
            .BorderAround Weight:=xlThin
            With .Rows(1)
                .Font.Size = 11
                .Interior.ColorIndex = 38
                .BorderAround Weight:=xlThin
            End With
            .Columns.AutoFit
            .Sort key1:=.Cells(1), order1:=1, Header:=1
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Il n'est pas nécessaire de trier tes données.

klin89

Bonjour

Formule en AQ2 (Matricielle) à incrémenter vers le bas

=SI(NB.SI('Saisies des cuveries'!$A$6:$A$171;$AP3)=0;"Non renseignée";INDIRECT("'Saisies des cuveries'!$H"&MAX(SI(('Saisies des cuveries'!$A$6:$A$171=$AP3)*('Saisies des cuveries'!$B$6:$B$171<>"");LIGNE('Saisies des cuveries'!$B$6:$B$171)))))

Cordialement

21pakal.zip (105.15 Ko)

Tout d'abord merci à tous pour vos réponses !!!

J'ai 3 ou 4 fichiers de ce genre à faire, je vais donc tester les 2 solutions (VBA et Formules matricielles). Sachant que je ne suis pas trop calé en VBA ca risque d'être un peu plus dur mais je pense que cela m'apportera plus de souplesse dans mes données. En tout cas, j'ai fait un premier test avec les 2 solutions et elle fonctionnent parfaitement.

donc un grand merci à tous !!

Re pakal,

Remplaces cette ligne :

If a(.Item(txt), 2) <= a(i, 2) Then

par celle-ci :

If CDate(a(.Item(txt), 2)) <= CDate(a(i, 2)) Then

klin89

Re,

Le code réajusté, il y avait des problèmes de retranscription de certaines dates (inversion jours/mois)

A tester, bien sûr 8)

Option Explicit

Sub Cuverie()
Dim a, i As Long, j As Long, txt As String, n As Long
    Application.ScreenUpdating = False
    With Sheets(1).Range("A5").CurrentRegion
        a = Application.Index(.Value, Evaluate("row(1:" & _
                                               .Rows.Count & ")"), Array(1, 2, 4, 8, 9))
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        n = 1
        For i = 2 To UBound(a, 1)
            txt = a(i, 1)
            If Not .exists(txt) Then
                n = n + 1
                .Item(txt) = n
                a(n, 1) = a(i, 1)
                a(n, 2) = CDate(a(i, 2))
                For j = 3 To UBound(a, 2)
                    a(n, j) = a(i, j)
                Next
            Else
                If CDate(a(.Item(txt), 2)) <= CDate(a(i, 2)) Then
                    a(.Item(txt), 1) = a(i, 1)
                    a(.Item(txt), 2) = CDate(a(i, 2))
                    For j = 3 To UBound(a, 2)
                        a(.Item(txt), j) = a(i, j)
                    Next
                End If
            End If
        Next
    End With
    With Sheets("Feuil1").Range("A1")
        .CurrentRegion.Clear
        .Cells(1).Resize(n, UBound(a, 2)).Value = a
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders(xlInsideVertical).Weight = xlThin
            .BorderAround Weight:=xlThin
            With .Rows(1)
                .Font.Size = 11
                .Interior.ColorIndex = 38
                .BorderAround Weight:=xlThin
            End With
            .Columns.AutoFit
            .Sort key1:=.Cells(1), order1:=1, Header:=1
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour,

Et une autre approche avec tableau et TCD.

Cdlt.

31pakal.xlsm (64.16 Ko)
Rechercher des sujets similaires à "extraire donnees fonction dernieres dates"