Rapport: Supprimer les doublons et faire un relevé des personnes restantes
b
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!
A
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 SubCdlt