Re : Un peut d'aide ne serait pas de refus
Re
Je viens de survoler ta macro : t'es dans le KK
J'explique : i = 3000
les 3 cellules Bi, Ci et Ei sont vides, ainsi que B(i-1), C(i-1) et E(i-1)
Cells(i, 5).Value = Cells(i - 1, 5).Value And Cells(i, 3) = Cells(i - 1, 3) identique à :
Range("E" & i)=Range("E" & i-1) and Range("C" & i)=Range("C" & i-1)
1er passage dans la boucle Do While
i=3000 => i-1=2999
(Ei=E(i-1)) et (Ci=C(i-1)) => (0=0 et 0=0) =VRAI donc instruction suivante
Bi= vide & ", " vide => Bi=", "
effacement ligne i-1 => Bi devient B(i-1)
Loop => retour au test
2ème passage dans la boucle Do While
i=3000 => i-1=2999
(Ei=E(i-1)) et (Ci=C(i-1)) => (0=0 et 0=0) =VRAI donc instruction suivante
Bi= ", " & ", " & vide => Bi=", , "
effacement ligne i-1 => Bi devient B(i-1)
Loop => retour au test
N-nième passage dans la boucle Do While
i=3000 => i-1=2999
(Ei=E(i-1)) et (Ci=C(i-1)) => (0=0 et 0=0) =VRAI donc instruction suivante
Bi= ", " & ", " & vide => Bi=", , , , , , , , , , , , , , , , , , , , , , , "
effacement ligne i-1 => Bi devient B(i-1)
Loop => retour au test
Ouaff, ouaff, ouaf (je peux me moquer, j'ai fait pareil et même pire) Et en plus, t'es pas loin : il suffit de remplacer
Do While Cells(i, 5).Value = Cells(i - 1, 5).Value And Cells(i, 3) = Cells(i - 1, 3)
Loop par un test If ... Then
ce qui donne
if Cells(i, 5) = Cells(i - 1, 5) And Cells(i, 3) = Cells(i - 1, 3) then
Cells(i, 2) = Cells(i - 1, 2) & ", " & Cells(i, 2)
Rows(i - 1).Delete
endif
Si les 2 paires de cellules ne sont pas identiques, je ne fais rien et je passe à la ligne précédente (step -1)
Je suis à la ligne 200, et les 2 paires sont identiques
je concatène : B200 = B199 & ", " & B200
Je supprime ligne 199 => donc B200 devient B199
en passant sur next, je suis renvoyé à For et i(=200) devient 199
Je teste la ligne 199 avec la ligne 198 : donc ça marche
Ta ligne :
For i = 3000 To 18 Step -1 me gêne (comme disait Marco Polo)
Je verrais plutôt un test de la colonne B pour trouver la dernière cellule non-vide
Ce qui donne une macro dans le style
Sub Modif_format2()
On Error GoTo Erreur_Modif_format2
Dim i As Long
Application.ScreenUpdating = False
If Range("B65535").End(xlUp).Rows < 19 Then GoTo Sortie_Modif_format2
For i = Range("B65535").End(xlUp).Row To 18 Step -1
If Cells(i, 5) = Cells(i - 1, 5) And Cells(i, 3) = Cells(i - 1, 3) Then
Cells(i, 2) = Cells(i - 1, 2) & ", " & Cells(i, 2)
Rows(i - 1).Delete
End If
Next i
Sortie_Modif_format2:
Application.ScreenUpdating = True
Exit Sub
Erreur_Modif_format2:
MsgBox (Err.Number & " - " & Err.Description)
Resume Sortie_Modif_format2
End Sub
A+