Correction VBA
Résolu
chevrotine22
Messages postés
22
Statut
Membre
-
chevrotine22 Messages postés 22 Statut Membre -
chevrotine22 Messages postés 22 Statut Membre -
Bonjour,
Je dispose d'un tableau d'on la premiere colonne est une date au format "m/d/yyyy h:mm"
J'utilise un marcro qui doit:
- Si on est lundi supprimer toute les lignes autre que le Lundi en cours et les Samedi et Dimanche passé
- Sinon que ca isupprimer toute les lignes autre que le jours en cours et la veille.
Le code donne ca:
Dim i As Integer
i = 2 'Si ta première date est à la ligne 2
If Weekday(Now()) = 2 Then 'Lundi est le 2eme jour selon la norme US
While ActiveSheet.Cells(i, 1).Value <> ""
If Weekday(ActiveSheet.Cells(i, 1)) <> 1 And Weekday(ActiveSheet.Cells(i, 1)) <> 7 And Weekday(ActiveSheet.Cells(i, 1)) <> 2 Then 'On vérifie qu'on n'est ni samedi ni dimanche ni lundi
ActiveSheet.Cells(i, 1).EntireRow.Delete
i = i - 1
End If
i = i + 1
Wend
Else
While ActiveSheet.Cells(i, 1).Value <> ""
If Weekday(ActiveSheet.Cells(i, 1)) <> Weekday(Now()) And Weekday(ActiveSheet.Cells(i, 1)) <> Weekday(Now()) - 1 Then 'On cherche les jours de la semaine qui ne sont ni celui d'aujourd'hui ni celui d'hier
ActiveSheet.Cells(i, 1).EntireRow.Delete
i = i - 1
End If
i = i + 1
Wend
End If
Le probleme c'est que ne supprime pas les jours de la semaine précédente.
Si quelqu'un connait la solution merci
Je dispose d'un tableau d'on la premiere colonne est une date au format "m/d/yyyy h:mm"
J'utilise un marcro qui doit:
- Si on est lundi supprimer toute les lignes autre que le Lundi en cours et les Samedi et Dimanche passé
- Sinon que ca isupprimer toute les lignes autre que le jours en cours et la veille.
Le code donne ca:
Dim i As Integer
i = 2 'Si ta première date est à la ligne 2
If Weekday(Now()) = 2 Then 'Lundi est le 2eme jour selon la norme US
While ActiveSheet.Cells(i, 1).Value <> ""
If Weekday(ActiveSheet.Cells(i, 1)) <> 1 And Weekday(ActiveSheet.Cells(i, 1)) <> 7 And Weekday(ActiveSheet.Cells(i, 1)) <> 2 Then 'On vérifie qu'on n'est ni samedi ni dimanche ni lundi
ActiveSheet.Cells(i, 1).EntireRow.Delete
i = i - 1
End If
i = i + 1
Wend
Else
While ActiveSheet.Cells(i, 1).Value <> ""
If Weekday(ActiveSheet.Cells(i, 1)) <> Weekday(Now()) And Weekday(ActiveSheet.Cells(i, 1)) <> Weekday(Now()) - 1 Then 'On cherche les jours de la semaine qui ne sont ni celui d'aujourd'hui ni celui d'hier
ActiveSheet.Cells(i, 1).EntireRow.Delete
i = i - 1
End If
i = i + 1
Wend
End If
Le probleme c'est que ne supprime pas les jours de la semaine précédente.
Si quelqu'un connait la solution merci
5 réponses
-
Bonjour,
si je comprends ta problématique :
- si on est lundi : il faut garder la veille, l'avant veille et le jour j. Autrement dit si on est lundi 16 décembre, ne doit plus rester que le samedi 14 décembre, dimanche 15 décembre et le 16 décembre.
- Sinon, on garde le jour + la veille.
Voici comment modifier ton code :
sub jours Dim i As Integer i = 2 'Si ta première date est à la ligne 2 do while cells(i,1)<>"" jourcell = day(cells(i,1)) & "/" & month(cells(i,1)) & "/" & year(cells(i,1)) jourcell = format(jourcell, "dd/mm/yyyy") If Day(Date) = 2 Then ' si le jour de la date du jour est un lundi If jourcell <>Format(Date - 2, "dd/mm/yyyy") Or jourcell <> Format(Date - 1, "dd/mm/yyyy") Or b <> Format(Date , "dd/mm/yyyy") Then ' si la date de la cellule est différente de l'avant veille, de la veille ou du jour j alors ActiveSheet.Cells(i, 1).EntireRow.Delete End If Else If jourcell <> Format(Date - 1, "dd/mm/yyyy") Or b <> Format(Date , "dd/mm/yyyy") Then ' si on n'est pas lundi, si la date de la cellule est différente de de la veille ou du jour j alors ActiveSheet.Cells(i, 1).EntireRow.Delete End If end if i=i+1 loop end sub
-
Bonjour,
A testerSub Test()
With ThisWorkbook.ActiveSheet
If Weekday(Date) = 2 Then 'Lundi est le 2eme jour selon la norme US
SupprimerLigne Date - 2, Date
Else
SupprimerLigne Date - 1, Date
End If
End With
End Sub
Sub SupprimerLigne(LimiteB As Date, LimiteH As Date)
Dim Ligne As Long
With ThisWorkbook.ActiveSheet
For Ligne = .Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
If .Cells(Ligne, 1) < LimiteB Or .Cells(Ligne, 1) > LimiteH Then .Rows(Ligne).Delete
Next Ligne
End With
End Sub
A+ -
Bonjour,
Gyrus ta solution est presque bonne, juste ca supprime aussi les lignes de la journée en cours
merci -
C'est très certainement parce que tes dates intègrent également les heures.
Essaie avecIf Int(.Cells(Ligne, 1)) < LimiteB Or Int(.Cells(Ligne, 1)) > LimiteH Then .Rows(Ligne).Delete
A+ -
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
