Suppression de ligne dans une boucle Résolu

Question

Bonjour, 

Voilà mon code :

Sub RETRAITEMENTS()

Dim DL As Long

Range("A:E,J:O,Q:Q,S:S").Delete

DL = Cells(Application.Rows.Count, 5).End(xlUp).Row

For i = DL To 5 Step -1

If Range("A" & i) = "" Then
    Range("A" & i).Value = Range("A" & i - 1).Value
    Range("B" & i).Value = Range("B" & i - 1).Value
    Range("C" & i).Value = Range("C" & i - 1).Value
    Range("D" & i).Value = Range("D" & i - 1).Value
    Range("F" & i).Value = Range("F" & i - 1).Value
    Range("G" & i).Value = Range("G" & i - 1).Value
    Range("H" & i).Value = Range("H" & i - 1).Value
    Range("I" & i).Value = Range("I" & i - 1).Value
Rows(i - 1).Delete

i = i - 1

End If

Next i

End Sub

Rien de bien compliqué, je veux que si la cellule de la ligne i colonne A est vide, les cellules A, B ,C, D ,F, G, H, I passent de la ligne i-1 à la ligne i et que la ligne i-1 soit supprimée.

Je vous joins le document anonymé. En fait, vous avez parfois plusieurs lignes pour une seule facture. Et la montant de la facture est la somme en dessous. Comme si j'avais des sous-totaux sur excel (il s'agit d'une extraction). Le problème est que quand j'ai plusieurs lignes, elles continuent d'apparaître après le lancement de la macro.

https://www.cjoint.com/c/EIymAzwhCMf

Ce que je veux, c'est n'avoir qu'une ligne par facture pour le montant total de la facture, avec les données des lignes précédentes pour A, B ,C ,D ,F, G , H ,I. Ces colonnes sont celles prises après : 

Range("A:E,J:O,Q:Q,S:S").Delete

Merci de votre aide.

pijaku · Answer

Re-

Il te faut un second test lorsque Ai n'est pas vide...
Teste par exemple si Bi = Bi + 1 ET Ci = Ci + 1 
Autre souci les dates en colonne A sont modifiées chez moi. Donc j'ai ajouté CDate()
Donc quelque chose comme : 
 Sub RETRAITEMENTS()Dim DL As LongRange("A:E,J:O,Q:Q,S:S").DeleteDL = Cells(Application.Rows.Count, 5).End(xlUp).RowFor i = DL To 5 Step -1If Range("A" & i) = "" Then    Range("A" & i).Value = CDate(Range("A" & i - 1).Value)    Range("B" & i).Value = Range("B" & i - 1).Value    Range("C" & i).Value = Range("C" & i - 1).Value    Range("D" & i).Value = Range("D" & i - 1).Value    Range("F" & i).Value = Range("F" & i - 1).Value    Range("G" & i).Value = Range("G" & i - 1).Value    Range("H" & i).Value = Range("H" & i - 1).Value    Range("I" & i).Value = CDate(Range("I" & i - 1).Value)Rows(i - 1).Deletei = i - 1ElseIf Range("B" & i) = Range("B" & i + 1) And Range("C" & i) = Range("C" & i + 1) Then    Rows(i).DeleteEnd IfNext iEnd Sub

pijaku · Answer

Bonjour,

Il te faut refaire la mise en forme en fin de macro.
Pour cela, créer une seconde Sub avec la mise en forme Arial, 8.5, alignement horizontal et vertical...
Cela te donne, au final, ces deux procédures :

Sub RETRAITEMENTS()
Dim DL As Long
   Range("A:E,J:O,Q:Q,S:S").Delete
   DL = Cells(Application.Rows.Count, 5).End(xlUp).Row
   For i = DL To 5 Step -1
      If Range("A" & i) = "" Then
          Range("A" & i).Value = CDate(Range("A" & i - 1).Value)
          Range("B" & i).Value = Range("B" & i - 1).Value
          Range("C" & i).Value = Range("C" & i - 1).Value
          Range("D" & i).Value = Range("D" & i - 1).Value
          Range("F" & i).Value = Range("F" & i - 1).Value
          Range("G" & i).Value = Range("G" & i - 1).Value
          Range("H" & i).Value = Range("H" & i - 1).Value
          Range("I" & i).Value = CDate(Range("I" & i - 1).Value)
         Rows(i - 1).Delete
         i = i - 1
      ElseIf Range("B" & i) = Range("B" & i + 1) And Range("C" & i) = Range("C" & i + 1) Then
          Rows(i).Delete
      End If
   Next i
   DL = Cells(Application.Rows.Count, 5).End(xlUp).Row
   Mise_En_Forme Range("A2:V" & DL)
End Sub

Sub Mise_En_Forme(RngSelect As Range)
    With RngSelect
      With .Font
        .Name = "Arial"
        .Size = 8.5
      End With
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
    End With
End Sub

Suppression de ligne dans une boucle

2 réponses

Votre réponse

Discussions similaires