Suppression de ligne dans une boucle

Bonjour,

J'aurais besoin de votre aide pour un petit problème. Mon fichier sert à concaténer plusieurs infos.

J'ai plusieurs lignes avec différents thèmes. Chaque thème peux être en double, en triple... (c'est un sondage).

Le but, concaténer chaque thème dans une seule ligne et supprimer celles dont je me suis servi pour faire la copie.

Je joins un fichier d'exemple et le code est dans le module 1.

Mon problème :

Comme je suis dans une boucle, dès que je supprime la ligne, la macro zappe une ligne sur 2).

merci d'avance pour votre aide !

Tchio !

10classeur2.xlsm (17.20 Ko)

Bonjour

Commencer par le bas avec un incrément négatif

Bonsoir et merci pour votre réponse.

J'ai essayé avec l'incrément par le bas avec count to step mais je n'y arrive pas?

J'essaie de modifier cette ligne, sans succès :

For Each C In Worksheets("argos-supervision-programmes-ex").Range("I", Worksheets("argos-supervision-programmes-ex").Range("I2" & Worksheets("argos-supervision-programmes-ex").Rows.Count).End(xlUp)) to 2 step -1

Tchio !

RE

Pas possible en For each : utiliser une boucle classique

For i = Worksheets("argos-supervision-programmes-ex").Range("I" & Cells.Rows.Count).End(xlUp).Row To 2 Step -1

Re,

J'ai modifié, mais le problème c'est que je dois adapter tout le reste du code..

Voici le code complet :

Sub ARGOS()
Dim Rng, i, C As Range, firstAddress As String, Trouve As Boolean, Rng2, C2, C3 As Variant, Wsx, Ws As Worksheet, dl As Long
'
'For Each C In Worksheets("argos-supervision-programmes-ex").Range("I", Worksheets("argos-supervision-programmes-ex").Range("I2" & Worksheets("argos-supervision-programmes-ex").Rows.Count).End(xlUp)) to 2 step -1
For i = Worksheets("Feuil1").Range("I" & Cells.Rows.Count).End(xlUp).Row To 2 Step -1
j = C.Value
k = C.Address
k2 = C.Row
'C2 = Mid(C, 1, 5) '3 premiers caractères de Rng
If C.Offset(, 8).Value = "C" Then C.Offset(, 8).Value = "Conforme"
If C.Offset(, 8).Value = "NC" Then C.Offset(, 8).Value = "Non Conforme"
If C.Offset(, 8).Value = "BP" Then C.Offset(, 8).Value = "Bonne Pratique"
If C.Offset(, 9).Value = "N/A" Then
C.Offset(, 9).Value = C.Offset(, 7).Value & " : " & C.Offset(, 8).Value
If C.Offset(, 2).Value = "" Then C.Offset(, 9).Value = C.Offset(, 9).Value & ". FS N°" & C.Value
If C.Offset(, 2).Value <> "" Then C.Offset(, 9).Value = C.Offset(, 9).Value & ", observé sur " & C.Offset(, 2).Value & ". FS N°" & C.Value
If C.Offset(, 18).Value = "OUI" Then C.Offset(, 9).Value = C.Offset(, 9) & ". Photo disponnible auprès du CA EDF."
If C.Offset(, 6).Value = C.Offset(-1, 6).Value Then
C.Offset(-1, 9).Value = C.Offset(-1, 9).Value & Chr(13) & Chr(10) & Chr(13) & Chr(10) & C.Offset(, 9).Value
Rows(k2).EntireRow.Delete
End If
End If
'If C.Offset(, 17).Value <> "" Then
'
'
'End If
Next i
End Sub

RE

Tu peux optimiser

With Worksheets("argos-supervision-programmes-ex")
    For i = .Range("I" & Cells.Rows.Count).End(xlUp).Row To 2 Step -1

        Set C = .Cells(i, 9)
        j = C.Value
        k = C.Address

        Select Case C.Offset(, 8).Value
            Case "C"
                C.Offset(, 8).Value = "Conforme"
            Case "NC"
                C.Offset(, 8).Value = "Non Conforme"
            Case "BP"
                C.Offset(, 8).Value = "Bonne Pratique"
        End Select

        Select Case C.Offset(, 9).Value
            Case "N/A"
                C.Offset(, 9).Value = C.Offset(, 7).Value & " : " & C.Offset(, 8).Value
            Case ""
                C.Offset(, 9).Value = C.Offset(, 9).Value & ". FS N°" & C.Value
            Case Else
                C.Offset(, 9).Value = C.Offset(, 9).Value & ", observé sur " & C.Offset(, 2).Value & ". FS N°" & C.Value
        End Select

        Select Case C.Offset(, 18).Value
            Case "OUI"
                C.Offset(, 9).Value = C.Offset(, 9) & ". Photo disponnible auprès du CA EDF."
            Case Is = C.Offset(-1, 6).Value
                C.Offset(-1, 9).Value = C.Offset(-1, 9).Value & Chr(13) & Chr(10) & Chr(13) & Chr(10) & C.Offset(, 9).Value
                Rows(i).EntireRow.Delete
        End Select

    Next
End With

Edit : à noter que les lignes

j = C.Value
k = C.Address

semblent inutile

Je ne connais pas Select et Case mais je vais regarder demain et tester.

Je vous tiens au courant !

Merci pour votre aide,

Tchio !

Rechercher des sujets similaires à "suppression ligne boucle"