Correction VBA

Résolu
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

5 réponses

  1. 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
    
    0
    1. Bonjour,

      A tester
      Sub 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+
      0
      1. Bonjour,

        Gyrus ta solution est presque bonne, juste ca supprime aussi les lignes de la journée en cours

        merci
        0
        1. C'est très certainement parce que tes dates intègrent également les heures.
          Essaie avec
          If Int(.Cells(Ligne, 1)) < LimiteB Or Int(.Cells(Ligne, 1)) > LimiteH Then .Rows(Ligne).Delete

          A+
          0
          1. ca marche parfaitement merci
            0