olivthill | 
Voici une solution possible :
Code :
- ' Supprimer les doublons et regrouper les valeurs
- ' Au début : col A = identifiants, col B = nombres, col C = vide
- ' A la fin : col D = identifiants uniques, col E = sommes
- Public Sub grouper_col()
- Application.ScreenUpdating = False ' pour aller plus vite
- Set ma_feuille = ThisWorkbook.Sheets("Feuil1" )
-
- c_in1 = 1 ' Lecture à partir de la colonne A (A = 1)
- l_in1 = 1 ' à partir de la première ligne
- c_out1 = 4 ' Ecriture à partir de la colonne D (D = 4)
- l_out1 = 1 ' à partir de la première ligne
-
- ' Première boucle sur tous les identifiants distincts
- Do While Not IsEmpty(ma_feuille.Cells(l_in1, c_in1))
- ' Test si ligne déjà prise en compte
- If (ma_feuille.Cells(l_in1, c_in1 + 2).Value <> "x" ) Then
- ' Ligne non traitée
- ' Récupère l'idenfitiant
- val1 = ma_feuille.Cells(l_in1, c_in1)
- ' Le copie dans le tableau des résultats
- ma_feuille.Cells(l_out1, c_out1).Value = val1
-
- ' Deuxième boucle pour faire la somme
- sum1 = ma_feuille.Cells(l_in1, c_in1 + 1)
- l_in2 = l_in1 + 1
- Do While Not IsEmpty(ma_feuille.Cells(l_in2, c_in1))
- If (ma_feuille.Cells(l_in2, c_in1).Value = val1 _
- And ma_feuille.Cells(l_in2, c_in1 + 2).Value <> "x" ) Then
- sum1 = sum1 + ma_feuille.Cells(l_in2, c_in1 + 1).Value
- ' Met une croix dans la colonne C pour indiquer déjà vu
- ma_feuille.Cells(l_in2, c_in1 + 2).Value = "x"
- End If
- l_in2 = l_in2 + 1
- Loop
- ' Ecrit la somme
- ma_feuille.Cells(l_out1, c_out1 + 1).Value = sum1
- l_out1 = l_out1 + 1
-
- End If
- l_in1 = l_in1 + 1
- Loop
- Application.ScreenUpdating = True
- End Sub
|
 |
