Supprimer des cellules si la date est < à aujourd'hui

sylvestre09

XLDnaute Nouveau
Bonjour le forum je souhaite grace à un bouton supprimer dans toutes les feuilles de mon classeur les lignes ou j'ai une date inferieur ou egale à la date d'aujourd'hui dans la colonne E sachant que j'ai le meme tableau dans toutes les feuilles (sauf feuil1 et feuil2) voilà mon code qui bloque
Code:
Public Sub CB3_Click()
Dim L As Long, choix As Double, x As Long, y As Long, Dl As Long
Dim Sh As Worksheet, laDate As Long
Dim tboriginal, tbresult()

y = 0: laDate = Date

For Each Sh In Worksheets
  If Sh.Name <> "Feuil1" And Sh.Name <> "Feuil2" Then
    With Sh
                Dl = .Range("E65536").End(xlUp).Row
                tboriginal = .Range("A3:Q" & Dl) 'pour réinitialiser si erreur
                choix = Application.WorksheetFunction.CountIf(.Range("E3:E" & Dl), ">" & laDate)
                If choix > 0 Then
                  ReDim Preserve tbresult(1 To choix, 1 To 17)
                  For L = 3 To Dl
                    If .Range("E" & L) > Now Then
                      y = y + 1
                      For x = 1 To 17
                        tbresult(y, x) = .Cells(L, x) ' BLOQUE ICI
                      Next x
                    End If
                  Next L
                  .Range("A3:Q" & Dl).Delete (xlUp)
                  .Range("A3:Q" & choix + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                  .Range("A3:Q" & choix + 1) = tbresult
                End If
                If MsgBox("Etes-vous sur du résultat", vbOKCancel) = 2 Then
                  .Range("A3:Q" & choix + 1).Delete (xlUp)
                  .Range("A3:Q" & Dl).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                  .Range("A3:Q" & Dl) = tboriginal
                End If
    End With
  End If
Next Sh
 
End Sub

si quelqu'un pourrait m'aider ce serait gentil Merci d'avance !
 

Matheop

XLDnaute Occasionnel
Re : Supprimer des cellules si la date est < à aujourd'hui

Salut sylvestre09.

Pourquoi n'essaies-tu pas de passer par un DateDiff avec comme intervalle le jour et comme dates à comparer celle d'aujourd'hui et celle de tes cellules?

x = DateDiff("j", Date, "date_de_ta_cellule")

Si x est négatif alors la date de ta cellule est antérieure à la date du jour.
Si x est positif alors la date de ta cellule est ultérieure à la date du jour.
Si x est nulle alors la date de ta cellule est celle d'aujourd'hui.


Cordialement,
Mat'
 
Dernière édition:

Matheop

XLDnaute Occasionnel
Re : Supprimer des cellules si la date est < à aujourd'hui

Le but de cette 'fonction' est de te renvoyer un entier (en l'occurrence x dans le cas présent). Tu regardes le signe de cet entier et si x est négatif alors ça veut dire que la date que tu compares à celle d'aujourd'hui est antérieure (inférieure si tu préfères). Et si c'est le cas bah tu supprimes la ligne correspondante. L'intérêt de cette fonction est de déterminer si l'intervalle est positif ou non ce qui te permet de juger si la date est inférieure ou pas.

"Voici mon code qui bloque" -> je pensais que tu n'arrivais pas à déterminer si ta date était inférieure ou non..

Tu as un message d'erreur à l'endroit où ça bloque?*
 
Dernière édition:

Vorens

XLDnaute Occasionnel
Re : Supprimer des cellules si la date est < à aujourd'hui

Hello,


Comment va Syl ? =)

Si non, comme d'ab sans le fichier qui va avec c'est tendu tout plein mais ma boule de cristal me dit que l'erreur que tu as viens du faire que ton code cherche quelque chose dans un éléments qui n’existe pas.

Ma boule de crystal me dit aussi que tu parcours ton tableau par un boucle for pour chaque ligne et une autre pour chaque "colonne" mais imaginons que tu cherche une colonne qui n'existe pas...

Code:
For x = 1 To 17
                        tbresult(y, x) = .Cells(L, x) ' BLOQUE ICI
                      Next x
Par exemple tu as en fait 16 colonne dans ton tableau déclarer mais que le code va dans la 17eme. sa va gnoussé.

Bien sure cela n'est que supposition, ma boule de cristal ne sait pas tout. Il nous faudra ton fichier ( ou du moins la partie qui traite ce problème)

Tout ce qu'on peut être sur c'est que ton code cherche ou effectue quelque chose dans un endroit qu'il ne trouve pas.

Meilleures salutations
 

Discussions similaires

Réponses
2
Affichages
505

Statistiques des forums

Discussions
312 215
Messages
2 086 326
Membres
103 180
dernier inscrit
Vcr