Agrégation et suppression

bonjour,
je cherche à agreger des lignes d'une table selon la regle ci dessous :
si les cellules entre 3 et 18 sont identiques pour les lignes i et (i+1),
- sommer la case 58 de ces deux lignes dans la case de la ligne i
- supprimer la ligne i+1
- passer à la ligne suivante

voici ma macro :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

Sub agreger()   Dim i As Integer Dim j As Integer   For i = 2 To 500   For j = 3 To 18   If Cells(i, j) = Cells(i + 1, j) Then Cells(i, 58) = Cells(i + 1, 58).Value + Cells(i, 58).Value Rows(i + 1).Select Selection.EntireRow.Delete   Next j   End If   Next i   End Sub

---

malheureusement le résultat n'est pas le bon :
la cellule a sommer est sommée 18 fois, :)
puis celle d'en desous est supprimé
et cela sans prendre en compte la condition que les 18 premiere cellules des deux lignes soit identique.

HELP!!

Bonjour,

Il faut éviter d'aller dans ce sens-là, lorsque l'on supprime dans une boucle (croche-pieds inévitables ainsi) !
Va dans l'autre sens :

Code:

---

For i = 500 To 2 step -1

---

et adapte ton traitement en fonction de ce sens de parcours

ca ne marche toujours pas

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Sub agreger()   Dim i As Integer Dim j As Integer   For i = 500 To 2 Step -1   For j = 3 To 18   If Cells(i, j) = Cells(i - 1, j) Then Cells(i, 58) = Cells(i - 1, 58).Value + Cells(i, 58).Value Rows(i).Select Selection.EntireRow.Delete End If   Next j   Next i         End Sub

---

Bonjour,
pas sur de te comprendre il y a une grosse différence entre ton code et ta demande.
Tu dis
"si les cellules entre 3 et 18 sont identiques pour les lignes i et (i+1), "
ca et la derniere ligne me fai pensé que les 18 cellule doivent toutes etre identique. hors dans ton programe tu en teste une tu fait ta petites afaire tu teste la suivante tu refait ta petite affaireetc etc....

Alors quele est le bon?
si c'est le premier utilise un flag (voir un cour d'algo pour plus d'infos)

dim bob as boolean

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Sub agreger()   Dim i As Integer Dim j As Integer dim Bob as boolean 'c'est Bob le porte drapeau   For i = 500 To 2 step -1 'ucfoutu a raison il faut toujours aller a l'envers quand on supprime des lignes bob=false 'On donne sont drapeau initiale a Bob For j = 3 To 18   If Cells(i, j) <> Cells(i + 1, j) Then Bob =true 'si on detect une différence Bob est vrai Next j if not Bob then 'si a la fin des 18 cellule on a pas trouvé de différence alors on fait l'adition et la supression s'il y avait une différence on ne la fait pas Cells(i, 58) = Cells(i + 1, 58).Value + Cells(i, 58).Value Rows(i + 1).Delete end if   Next i   End Sub

---

il sembel que cela marche, effectivement
merci pour votre aide