Suppression de lignes si condition remplie
Résolu
Landoltp
Messages postés
68
Date d'inscription
Statut
Membre
Dernière intervention
-
Landoltp Messages postés 68 Date d'inscription Statut Membre Dernière intervention -
Landoltp Messages postés 68 Date d'inscription Statut Membre Dernière intervention -
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
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
A voir également:
- Suppression de lignes si condition remplie
- Forcer suppression fichier - Guide
- Excel cellule couleur si condition texte - Guide
- Partage de photos en ligne - Guide
- Suppression compte gmail - Guide
- Suppression page word - Guide
5 réponses
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...
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...
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
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
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?
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?
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.
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.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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
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
