Rapport: Supprimer les doublons et faire un relevé des personnes restantes

Bonjour,

Je migre un logiciel de contrôle d'accès chez un client. Sur son ancien logiciel, il utilisait un rapport (.xls) qui lui affiché le nombre de personne ayant eu accès au bâtiment pendant une journée. Il y avait donc dans ce fichier un certains nombre de doublons. A l'aide d'une macro excel, il arrivait à supprimer ces doublons puis de les regrouper dans le haut de sa colonne. J'ai essayé d'utiliser sa macro, les doublons disparaissent bien mais les personnes ne sont pas regrouper en haut de la colonne donc j'obtiens un nombre erroné. Je vous joins son fichier ainsi que sa macro. Merci d'avance!

16module1.txt (1.57 Ko)

Bonjour,

Si j'ai bien compris:

Option Explicit

Sub DOUBLONS()
    Dim DerLig&, DerCol&, t, dico As New Dictionary, i&, Debut
    Application.ScreenUpdating = False

    With Sheets("TEST")
       Debut = Timer
       If .FilterMode Then .ShowAllData
       DerLig = .Cells(.Rows.Count, "k").End(xlUp).Row
       DerCol = .Range("ZZ1").End(xlToLeft).Column
       dico.CompareMode = TextCompare
       t = .Cells(1, "k").Resize(DerLig)

       For i = 6 To DerLig: dico(t(i, 1)) = dico(t(i, 1)) + 1: Next

       For i = UBound(t) To 1 Step -1
          If dico(t(i, 1)) > 1 Then
             dico(t(i, 1)) = dico(t(i, 1)) - 1
             t(i, 1) = "#N/A"
          Else
             t(i, 1) = i
          End If
       Next i

       .Cells(1, DerCol).Resize(DerLig) = t
       .Range(.Cells(1, "a"), .Cells(DerLig, DerCol)).Sort key1:=.Cells(1, 11), order1:=xlAscending, Header:=xlYes
       On Error Resume Next
       .Cells(1, DerCol).Resize(DerLig).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
       '.Cells(1, DerCol).EntireColumn.Delete
       MsgBox "Initialement " & Format(DerLig - 1, "#,##0") & " enregistrements" & vbLf & _
              "qui correspondaient à " & Format(.Cells(.Rows.Count, "k").End(xlUp).Row - 1, "#,##0") & " personnes distinctes." & vbLf & _
              Format(DerLig - .Cells(.Rows.Count, "k").End(xlUp).Row, "#,##0") & " doublons ont donc été supprimés." & vbLf & _
              "La durée d'exécution a été de " & Format(Timer - Debut, "0.00\ sec.")
    End With
End Sub

Cdlt

Rechercher des sujets similaires à "rapport supprimer doublons releve personnes restantes"