Sub travdem()
...................................................
With Sheets("Feuil1") '(Nomfeuille1)(ActiveSheet.Name)
Dl1 = .Range(Col1 & .Rows.Count).End(xlUp).Row
'
'on utilise les colonnes B à F
'
Set Plg1 = .Range("B11:F" & Dl1) 'plage de données Nom prenom père
.........................
For Compt1 = LBound(MonTab, 1) To UBound(MonTab, 1)
On Error GoTo suite:
If MonTab(Compt1, 1) <> "" Then
' colonne B Colonne C Colonne D
Data1 = Trim(MonTab(Compt1, 1)) & Trim(MonTab(Compt1, 2)) & Trim(MonTab(Compt1, 3))
mois colonne F année Colonne F
Date1 = Month(MonTab(Compt1, 5)) & Year(MonTab(Compt1, 5))
Data2 = Data1 & Date1
'Une collection ne comporte pas des données en double. Si on ajoute une valeur dans la collection on a une erreur. On utilise cette erreur pour compter le nombre de valeur identique.
Collec.Add Data2, CStr(Data2)'
If Flag = False Then 'si flag= faux ce n'est pas un doublon
On Error GoTo 0
' mémorisation dans un tableau les données pour l'userform
Tbl(Compt2, 0) = Trim(MonTab(Compt1, 1)) 'colonne B
Tbl(Compt2, 1) = Trim(MonTab(Compt1, 2))'colonne C
Tbl(Compt2, 2) = Trim(MonTab(Compt1, 3))'colonne D
Tbl(Compt2, 3) = CStr(MonTab(Compt1, 5))'colonne F
Tbl(Compt2, 4) = "1"
Compt2 = Compt2 + 1
End If
End If
Flag = False
Next Compt1
End With
Exit Sub
suite:
' doublon trouvé
Flag = True
' recherche de la ligne qui contient les données identiques (avec la fonction logique ET),
For I1 = LBound(Tbl, 1) To UBound(Tbl, 1)
If Tbl(I1, 0) = Trim(MonTab(Compt1, 1)) And _
Tbl(I1, 1) = Trim(MonTab(Compt1, 2)) And _
Tbl(I1, 2) = Trim(MonTab(Compt1, 3)) And _
Tbl(I1, 3) = CStr(MonTab(Compt1, 5)) Then
Tbl(I1, 4) = Val(Tbl(I1, 4)) + 1 'Incrémentation
If Tbl(I1, 0) = "" Then Exit Sub
Exit For
End If
Next I1
Resume Next
End Sub