Tri selon deux noms identiques et une date

Bonjour à tous,

j'explique vite mon petit souci.

Je travaille sur des requêtes à partir d'une base de données que j'enregistre sous forme d'un tableau excel (environ 3000 lignes).

Ce tableau repose sur le nom formaté de la personne et sur des dates successives de présence. Ce que j'aimerais faire (ou avoir), c'est pouvoir trier ce tableau selon qu'une personne soit présente au moins deux fois dans le tableau - et que cette deuxième présence soit supérieure à une date.

Selon l'exemple que je donne, je voudrais trier le tableau selon la deuxième apparition du nom dans le tableau et supérieur ou égal au 20/01/2011 dans la colonne "date 2".

Merci de votre aide.

Bonjour

Un essai avec macro

Merci pour la macro. Je n'ai pas eu encore le temps de regarder en détail comment elle fonctionne. Je vois ça demain.

Merci du coup de main.

-- 11 Fév 2011, 14:13 --

Bon, la macro fonctionne (à 99%).

Voici comment je l'ai adaptée à ma situation :

Option Explicit

Sub Extraction()
Dim Cel As Range
Dim MonDico As Object

  Columns("S:T").ClearContents
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each Cel In Range("B2:B" & Range("B65536").End(xlUp).Row)

    If Cel.Offset(0, 13) >= Range("O2") And Application.CountIf(Columns(2), Cel.Text) > 1 Then
      If MonDico.exists(Cel.Text) Then                         ' Si la clef existe
        If MonDico.Item(Cel.Text) > Cel.Offset(0, 13) Then      ' La valeur associée est > à la valeur lue ?
          MonDico.Item(Cel.Text) = Cel.Offset(0, 13)            ' Si oui on remplace la valeur associée
        End If
      Else
        MonDico.Add Cel.Text, Cel.Offset(0, 13)
      End If
    End If
  Next Cel

  Range("S2").Resize(MonDico.Count) = Application.Transpose(MonDico.keys)
  Range("T2").Resize(MonDico.Count) = Application.Transpose(MonDico.items)

  If MonDico.Count > 1 Then
    With Range("S2:T2").Resize(MonDico.Count, 2)
      .Sort Key1:=Range("S2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End With
  End If

End Sub

Ce que j'aimerais, c'est pouvoir copier ces données non pas dans les colonnes S2 et T2, mais plutôt sur une nouvelle feuille. J'ai essayé avec Sheets.add et autres petites choses trouvées sur internet, mais j'avoue patauger. Je me chope une erreur d'indice. Je suis assez (très) novice en VBA.

Et je voulais savoir comment améliorer, à la rigueur, ce code pour enregistrer en plus du nom et de la date, d'autres informations se trouvant sur la même ligne...

Quoiqu'il en soit, merci pour cette macro.

Edit : ah oui, aussi, une petite chose, le tri s'effectue bien, mais j'ai des données qui apparaissent non pas sous format de date - mais sous un format numérique (celles-ci concernent des dates supérieures à la date repère mais au-delà de la seconde apparition du nom). Comment supprimer ou affiner cela ?

Merci.

-- 11 Fév 2011, 14:58 --

Re-Edit : En fait, non, il y a un petit problème de conversion de date. Les dates qui s'affichent correctement ne le font uniquement que parce qu'elles sont du style 21/01, donc supérieures au compte des mois.

Lorsqu'il y a une valeur numérique au lieu de la date, c'est qu'il y a confusion : le 8 février 2011 (08/02/2011) est lu comme le 2 août 2011 (02/08/2011) - et donc système américain (ou anglo-saxon, je ne sais pas).

Comment peut-on faire pour régler ce problème de conversion ?

Bonjour

Juste pour faire remonter ton message suite à ton fil sur "Forum Excel Pratique"

https://forum.excel-pratique.com/forum-excel-pratique/quid-d-une-reponse-a-soi-meme-t21480.html

Amicalement

Nad

Bonjour

C'est vrai que tes réponses étaient passées inaperçues

Pas pratique

Bon je t'ai modifié le fichier

L'objet Dictionary ne permet de stocker que deux valeurs (c'était le nom et la date) mais comme tu veux récupérer plus de données j'ai un petit peu rusé en stockant le nom et l'adresse de la cellule contenant la date, et à partir de celle-ci on peut récupérer les bonnes valeurs, en faisant varier la valeur dans Offset

Pour les valeurs numériques, a mon avis, c'est que le format de cellule n'était pas au format date

Cette version corrige ce problème (enfin je crois)

Pour

Lorsqu'il y a une valeur numérique au lieu de la date, c'est qu'il y a confusion : le 8 février 2011 (08/02/2011) est lu comme le 2 août 2011 (02/08/2011) - et donc système américain (ou anglo-saxon, je ne sais pas).

Comment peut-on faire pour régler ce problème de conversion ?

Je n'ai actuellement pas de solution

A suivre

Bonne journée

Bonjour,

Merci beaucoup pour la macro, elle fonctionne cette fois vraiment à 99%...

Pour le problème de date, la commande CDATE fonctionne très bien.

Voici comment je l'ai réadaptée à ma situation :

Option Explicit

Sub Extraction()
Dim Cel As Range
Dim MonDico As Object
Dim J As Integer
Dim Tablo

  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each Cel In Range("B2:B" & Range("B65536").End(xlUp).Row)

    If Cel.Offset(0, 13) >= Range("O2") And Application.CountIf(Columns(2), Cel.Text) > 1 And Application.CountIf(Columns(2), Cel.Text) < 4 Then
      If MonDico.exists(Cel.Text) Then                                  ' Si la clef existe
        If Range(MonDico.Item(Cel.Text)) > Cel.Offset(0, 13) Then        ' La valeur associée est > à la valeur lue ?
          MonDico.Item(Cel.Text) = Cel.Offset(0, 13).Address             ' Si oui on remplace la valeur associée
        End If
      Else
        MonDico.Add Cel.Text, Cel.Offset(0, 13).Address
      End If
    End If
  Next Cel

  If MonDico.Count > 0 Then
    On Error Resume Next
    Sheets("Rapport").Visible = True
    If Err.Number > 0 Then
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Name = "Rapport"
      Sheets("Feuil1").Select
    End If
    On Error GoTo 0

    With Sheets("Rapport")
      .Columns("A:E").ClearContents
      Tablo = MonDico.items
      .Range("A1").Resize(MonDico.Count) = Application.Transpose(MonDico.keys)
      For J = 0 To UBound(Tablo)
        .Range("B" & J + 1) = CDate(Range(Tablo(J)))
        .Range("C" & J + 1) = Range(Tablo(J)).Offset(0, -9)
        .Range("D" & J + 1) = Range(Tablo(J)).Offset(0, -8)
        .Range("E" & J + 1) = Range(Tablo(J)).Offset(0, -14)
    Next J
      If MonDico.Count > 1 Then
        With .Range("A1:E1").Resize(MonDico.Count, 5)
          .Sort Key1:=Sheets("Rapport").Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
        End With
      End If
    End With
  End If

End Sub

Elle est très bien comme ça déjà, mais si je pouvais fignoler un peu, je remarque que certaines personnes apparaissent dans le rapport parce qu'elles ont une date > au 21/01, mais à leur deuxième venue, c'est < au 21/01.

Comment pourrais-je mieux borner cela ?

(je suis un adepte des économies de temps dans le travail ^^).

En tous cas, merci beaucoup.

Bonjour

Une nouvelle version à tester

Bonjour,

merci pour cette dernière macro - mais elle n'a pas apporté de solutions à mon petit problème (si ce n'est une autre compréhension du VBA) - ce qui n'est en fin de compte pas grave, puisque, actualisant deux fois par jour la requête, je n'aurai bientôt plus à faire de tri - et pourrai alors mettre comme variable =2 au lieu de 1<x<4.

Merci beaucoup (énormément) pour cette aide très précieuse.