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

Narta

XLDnaute Nouveau
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


ABCD
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é:


ABCD
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

XLDnaute Nouveau
Bonjour,


VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 924
Membres
101 841
dernier inscrit
ferid87