compter le nombre total des doublons en vba

[ricoricK]

Bonjour ou bonsoir, je ne sais plus quoi dire,

voila la fonction ci dessous liste parfaitement les doublons,

mais ne me donne pas le nombre total pour chaque doublon.

à mon avis le pb doit être
dans la boucle for.

si à cette heure quelqu'un à une idée, ou une proposition de code,je le remercie d'avance.bonne nuit

Sub cmptdoublon()
Dim Plage As Range
Dim Tableau(), Resultat() As String
Dim i As Integer, j As Integer, m As Integer
Dim Un As Collection
Dim Doublons As String

Set Un = New Collection
colonne à tester
Set Plage = Range("A1:A" & Range("A65536").End(xlUp).Row)


Tableau = Plage.Value

On Error Resume Next
'boucle sur la plage à tester
For i = 1 To Plage.Count

ReDim Preserve Resultat(2, m + 1)


Un.Add Tableau(i, 1), CStr(Tableau(i, 1))

'S'il y a une erreur (donc présence d'un doublon)
If Err <> 0 Then

'boucle sur le tableau des doublons pour vérifier s'il a déjà
'été identifié
For j = 1 To m + 1
'Si oui, on incrémente le compteur
If Resultat(1, j) = Tableau(i, 1) Then
Resultat(2, j) = Resultat(2, j) + 1
Err.Clear
Exit For
End If
Next j

'Si non, on ajoute le doublon dans le tableau
If Err <> 0 Then
Resultat(1, m + 1) = Tableau(i, 1)
Resultat(2, m + 1) = 1

m = m + 1
Err.Clear

End If
End If
Next i

'----- ici Affichage de la liste et le nombre de doublons
For j = 1 To m
Doublons = Doublons & Resultat(1, j) & " --> " & _
Resultat(2, j) & vbCrLf
Next j

MsgBox Doublons

Set Un = Nothing
End Sub

 

[jp14]

Re : compter le nombre total des doublons en vba

Bonjour

Ci joint une procédure à tester

Sub cmptdoublon()
Dim Plage As Range
Dim Tableau(), Resultat() As String
Dim i As Long, j As Long, m As Integer, j1 As Long
Dim Un As Collection
Dim trouve As Boolean
Dim Doublons As String

Set Un = New Collection
'colonne à tester
Set Plage = Range("A1:A" & Range("A65536").End(xlUp).Row)
ReDim Resultat(1 To Plage.Count, 1 To Plage.Count)

Tableau = Plage.Value
On Error GoTo suite
'boucle sur la plage à tester
For i = 1 To Plage.Count
        If Tableau(i, 1) <> "" Then
            Un.Add Tableau(i, 1), CStr(Tableau(i, 1))
        End If
Next i
Set Un = Nothing

For j = LBound(Resultat) To UBound(Resultat)
    If Resultat(j, 1) = "" Then
        j1 = j
        Exit For
    End If
Call MsgBox("Valeur :" & Resultat(j, 1) _
            & vbCrLf & "" _
            & vbCrLf & "Nombre trouvé : " & Resultat(j, 2) _
            , vbExclamation, "Doublons")

Next j


Exit Sub

suite:
trouve = False
For j = LBound(Resultat) To UBound(Resultat)
    If Resultat(j, 1) = Tableau(i, 1) Then
        Resultat(j, 2) = CLng(Resultat(j, 2)) + 1
        trouve = True
        Exit For
    End If
    If Resultat(j, 1) = "" Then
        j1 = j
        Exit For
    End If
    
Next j

If trouve = False Then
    Resultat(j1, 1) = Tableau(i, 1)
    Resultat(j1, 2) = 0
End If

Resume Next
End Sub

JP

 

[ricoricK]

Re : compter le nombre total des doublons en vba

merci JP je vais tester tous cela.