Macro bi condition pour copie du contenu d'une case avec celle du dessus Help Hervé

[Nann]

Salut tout le monde,

voici mon VBA:

Sub Modif_format()
Dim i As Integer

'Figeage de l'ecran durant l'execution de la macro
Application.ScreenUpdating = False
' boucle sur chaque ligne de la colonne E en commancant par la la ligne 19 jusqu'a la 3000
For i = Range("e19").Row To 3000 Step 1
' Si le contenue de la case dans la colonne E est égal a celui de la case du dessous
If (Cells(i, 5)) = (Cells(i + 1, 5)) Then
'(Et) Si le contenu de la case de la meme ligne mais de la colonne C
'est égal au contenu de la ligne du dessus de la colonne C
If (Cells(i, 3)) = (Cells(i + 1, 3)) Then
'on concatene les valeur de la colonne Bvaec une virgule entre les deux chaines
'de caractères
Cells(i, 2) = Cells(i, 2) & "," & Cells(i + 1, 2)
'on supprime la ligne du dessous
Rows(i + 1).Delete
'Sinon (ici mon problème)
Else

End If
End If
Next i
Range("A20").Select

En fait je veux comparais le contenue de 2 case superposées en colonne C et en colonne E :
- Et si le contenu et identique pour les deux cas, prendre le contenu de la case colonne B de la ligne du dessous et la collée dans la meme case avec une "virgule" entre les 2 puis effacée la ligne du dessous et recommencer avec la meme ligne et la nouvelle ligne du dessous
- Et si le contenu n'est pas identique, passer à la ligne du dessous

Mais la je bloque, je penses que je suis peut etre mal parti

Merci d'avance

 

[porcinet82]

Re : Macro bi condition pour copie du contenu d'une case avec celle du dessus Help Hervé

Salut Nann,

Alors tout d'abord, si tu avais lu Lien supprimé tu serais qu'il n'est pas poli de désigner un intervenant du forum dans le titre du fil.

Je ne vois pas tres bien ou se situe le problème, j'ai modifié le code de la manière suivante (si tu ne rentre pas ton If, la boucle passe a l'itération suivante) :

Sub Modif_format()
Dim i As Integer
Application.ScreenUpdating = False
For i = 19 To 3000 Step 1
    If Cells(i, 5).Value = Cells(i + 1, 5).Value And Cells(i, 3) = Cells(i + 1, 3) Then
        Cells(i, 2) = Cells(i, 2) & "," & Cells(i + 1, 2)
        Rows(i + 1).Delete
    End If
Next i
Application.ScreenUpdating = True
End Sub

@+

 

[Charly2]

Re : Macro bi condition pour copie du contenu d'une case avec celle du dessus Help Hervé

Bonsoir Nann, bonsoir Romain,
bonsoir à toutes et à tous 🙂

Je n'ai pas tout à fait compris comme toi, Romain. J'ai l'impression qu'il peut y avoir plus de 2 lignes dont les colonnes C et E sont identiques.

Pour ne pas tout réécrire à l'envers (For i = 3000 To 19 Step -1), tu peux utiliser ce genre de code :

Option Explicit

Const LigneDepart As Integer = 19
Const LigneFin As Integer = 3000

Sub Modif_format()
'
Dim i As Integer
'
Application.ScreenUpdating = False

' on initialise i avec le contenu de LigneDepart
i = LigneDepart

' puis on boucle tant que i <= LigneFin
Do While i <= LigneFin

If (Cells(i, 5) = Cells(i + 1, 5)) And _
(Cells(i, 3)) = (Cells(i + 1, 3)) Then

Cells(i, 2) = Cells(i, 2) & "," & Cells(i + 1, 2)
Rows(i + 1).Delete

Else

' on incrémente i seulement si la ligne du dessous
' n'a pas été supprimée
i = i + 1
End If

Loop

Range("A20").Select

Application.ScreenUpdating = True

End Sub

Let's wait and see 😉

A+