Suppression de lignes si condition remplie Résolu/Fermé

Question

bonjour,
j’ai fait un code sur Excel qui me permet de rentrer un nouvel emprunt à chaque fois que je clique sur un bouton :

Private Sub CmdOK_Click()

Sheets("SGBBE").Select
ActiveSheet.[AA].Select
Selection.End(xlDown).Select
If Selection.Address = "$A$65536" Then
Range("AA").Offset(1, 0).Select
Else
Selection.Offset(1, 0).Select
End If
ActiveCell.Value = UserForm1.Montantpret.Value
ActiveCell.NumberFormat = "#,##0"
ActiveCell.Offset(0, 1).Value = UserForm1.Datedeblocage.Value
ActiveCell.Offset(0, 1).NumberFormat = "dd.mm.yyyy"
ActiveCell.Offset(0, 2).Value = UserForm1.Taux.Value / 100
ActiveCell.Offset(0, 2).NumberFormat = "0.00%"
ActiveCell.Offset(0, 3).Value = UserForm1.Remboursement
If Remboursement = "Mensuel" Then
ActiveCell.Offset(0, 5).Value = DateSerial(Year(Datedeblocage), Month(Datedeblocage) + Nbreecheances, Day(Datedeblocage))
ElseIf Remboursement = "Trimestriel" Then
ActiveCell.Offset(0, 5).Value = DateSerial(Year(Datedeblocage), Month(Datedeblocage) + Nbreecheances * 3, Day(Datedeblocage))
ElseIf Remboursement = "Semestriel" Then
ActiveCell.Offset(0, 5).Value = DateSerial(Year(Datedeblocage), Month(Datedeblocage) + Nbreecheances * 6, Day(Datedeblocage))
ElseIf Remboursement = "In fine" Then
variable = MsgBox("La valeur 1 a été attribuée automatiquement à la variable: Nombre d'échéances" & vbLf & "Veuillez remplir la case: Date dernière échéance", vbExclamation + vbOKOnly, "Emprunt In fine")
End If
ActiveCell.Offset(0, 5).NumberFormat = "dd.mm.yyyy"
ActiveCell.Offset(0, 4).Value = UserForm1.Nbreecheances.Value
ActiveCell.Offset(0, 4).NumberFormat = "#,##0"
If Remboursement = "In fine" Then
ActiveCell.Offset(0, 4).Value = 1
End If
Unload Me

End Sub

maintenant j’aimerais créer un autre bouton qui me permette de supprimer tous les emprunts dont la date de la dernière échéance (offset(0,5)) est inférieure à aujourd’hui (la date se trouve dans la cellule A2) mais j’y arrive pas. En plus je pense que je ne peux pas utiliser le offset (0,5) car le nouveau bouton se trouve sur la feuille et pas dans le userform (code ci-dessus)...
Je voudrais également savoir si c’est possible ensuite de réaligner toutes les données restantes de sorte à ce qu’il n’y ait pas de ligne vide ?
merci d’avance

mdonnate · Answer

Pour supprimer les lignes vides, tu peux utiliser un code du type:

Sub supp_lignes()
'
'Dim myCtrl, dernLigne, I

'détermine le numéro de la dernière ligne utilisée
dernLigne = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Count - 1

'désactive la mise à jour de l'écran afin d'accélérer les traitements
Application.ScreenUpdating = False

'Pour toutes les lignes en partant de la dernière
For I = dernLigne To 1 Step -1

'La fonction Excel CountA correspond à =NBVAL
If Application.WorksheetFunction.CountA(Rows(I)) = 0 Then
Rows(I).Delete Shift:=xlUp
End If
Next I
End Sub

Landoltp · Answer

merci pour ta réponse, j'ai fait ça:

Dim myctrl, dernligne, I
If MsgBox("Etes-vous sûr de vouloir supprimer tous les emprunts à terme?", vbExclamation + vbOKCancel, "Suppression emprunts") = vbOK Then
    dernligne = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Count - 1
    Application.ScreenUpdating = False
    For I = dernligne To 1 Step -1
        If Application.WorksheetFunction.CountA(Rows(I)) < [A2] Then
        Rows(I).Delete shift:=xlUp
        End If
    Next I
Else
Cancel = True
End If

mais là il me supprime tout le tableau. en fait il faudrait qu'il me fasse le test pour chaque cellule (à partir de la n° 5) de la colonne F. une idée?

Landoltp · Answer

le plus proche que j'ai réussi à faire pour l'instant c'est ça:

Private Sub CommandButton2_Click()

'Dim myctrl, dernligne, I       'il semble qu'on est pas obligé de déclarer toutes ces variables...
'Dim lig     As Long
'Dim col     As String              
'Dim nbrlig  As Long
'Dim numlig  As Long

If MsgBox("Etes-vous sûr de vouloir supprimer tous les emprunts à terme?", vbExclamation + vbOKCancel, "Suppression emprunts") = vbOK Then
col = "F"                 ' colonne données non vides à tester'
With Sheets("feuil1")     ' feuille source'
nbrlig = .Cells(65536, col).End(xlUp).Row
  For lig = 5 To nbrlig             'n° de la 1ere ligne de données'
    If .Cells(lig, col).Value <> [B2] Then
        .Cells(lig, col).EntireRow.Delete
    End If
  Next
End With
Else
Cancel = True
End If
End Sub

le problème c'est qu'il fait une ligne sur deux à chaque fois qu'on lance le programme et il ne tient pas compte de [B2], il me laisse uniquement les lignes qui ont la valeur 0 dans la colonne F...

mdonnate · Answer

J'espère que ça pourra t'aider (je n'ai pas accès à excel pour le moment, je fais appel à ma mémoire)

Tu peux modifier ta macro comme suit:

For lig=5 to nbrlig
     z=DateDiff(.cells(lig,col),"B2")  'si j'ai bien compris tu as utilisé B2 pour la date du jour, mais tu peux essayer (.cells(lig,col),Now)
                                                       'il faudra déclarer z, bien sur, je pense en string c'est parfait
    If z<0 Then
        .Cells(lig,col).EntireRow.Delete
    End If
Next

Ce sera peut être z>0, je ne sais plus dans quel sens est faite la soustraction
Pour supprimer une ligne en fonction d'une cellule vide, tu peux aussi utiliser   If IsEmpty

Désolé de ne pas être plus précis, mais je ne peux pas essayer ce que je te propose.

Landoltp · Answer

finalement ça joue avec ce code:

Private Sub CommandButton5_Click()
Dim i As Integer
    Sheets("Feuil1").Select
    'si la colonne de dernière date est par ex "F"
    For i = 1 To Range("F65536").End(xlUp).Row
        If Cells(i, 6).Value <> "" And Cells(i, 6) < Now Then
           Cells(i, 6).EntireRow.Delete
           i = i - 1
'          --------
        End If
    Next i
End Sub

merci beaucoup pour ton aide

Suppression de lignes si condition remplie

5 réponses

Discussions similaires