XL 2016 Supprimer les lignes en double et incrémenter la quantité

[Narta]

Bonjour,
Je souhaite écrire un petit programme VBA qui permet de supprimer les lignes doublons et comptabiliser leur quantité.
Je m,explique: dans le fichier ci-joint. Je souhaite supprimer les doublons des lignes qui contiennent toto1 selon la colonne C, garder un seule ligne et afficher la quantité dans la colonne D

A	B	C	D
test_&	test_&	toto1	1​
test_&	test_&	toto2	1​
test_&	test_&	toto3	1​
test_&	test_&	toto1	1​
test_&	test_&	toto2	1​
test_&	test_&	toto6	1​
test_&	test_&	toto7	1​
test_&	test_&	toto8	1​
test_&	test_&	toto1	1​
test_&	test_&	toto10	1​
test_&	test_&	toto11	1​
test_&	test_&	toto2	1​
test_&	test_&	toto13	1​
test_&	test_&	toto14	1​
test_&	test_&	toto1	1​
test_&	test_&	toto16	1​
test_&	test_&	toto1	1​
test_&	test_&	toto2	1​

Resultat souhaité:

A	B	C	D
test_&	test_&	toto1	5​
test_&	test_&	toto2	3​
test_&	test_&	toto3	1​
test_&	test_&	toto6	1​
test_&	test_&	toto7	1​
test_&	test_&	toto8	1​
test_&	test_&	toto10	1​
test_&	test_&	toto11	1​
test_&	test_&	toto13	1​
test_&	test_&	toto14	1​
test_&	test_&	toto16	1​

merci de votre aide.

 

[Rossoneri83]

Bonjour,

Dim nbLigne As Integer, i As Integer, j As Integer

nbLigne = Range("A1").CurrentRegion.Rows.Count

  For i = 1 To nbLigne

    If Range("C" & i) = "" Then
    Exit Sub
    Else
      For j = nbLigne To i + 1 Step -1
        compteur = Range("D" & i).Value
          
          If Range("C" & i) = Range("C" & j) Then
          Range("D" & i) = compteur + 1 And Range("C" & j).EntireRow.Delete
          End If
          
      Next j
 
  End If
  Next i

Bonne journée

 

[M12]

Bonjour,
Un test

 

[Narta]

Bonjour, Merci pour vos réponse. je testerai et je vous dirai