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

Narta · 26 Août 2021

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 · 26 Août 2021

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

M12 · 26 Août 2021

Bonjour,
Un test

Narta · 26 Août 2021

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

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

Narta

XLDnaute Nouveau

Rossoneri83

XLDnaute Nouveau

M12

XLDnaute Accro

Pièces jointes

Narta

XLDnaute Nouveau

Discussions similaires