Effacer des cellules en fonction de la date

**jarault** · 14/04/2008, 17h50

Bonjour,

Je dois réaliser pour demain soir une macro conditionnelle, les données sont les suivantes
Dans la case I1 se strouve la date du jour.
Dans la plage A2:H151 se trouve les données à effacer
Dans la plage B2:B151 se touve les dates qui servent de référence.
La macro doit effacer la ligne si la date est <= I1+1 (soit la date de demain),
si c'est le cas pour la première ligne, les cellules de B2 à H2 devront être éffacées, sinon la ligne reste intacte et on passe à la ligne suivante.
Si l'on pouvait effacer la ligne entière j'aurais assez facilement trouvé la solution mais comme il existe à partir de la colonne I des données qu'il ne faut pas toucher cela devient plus compliquer pour moi.

Je suppose qu'il faut affecter une variable au numéro de ligne et utiliser celle-ci pour effectuer la macro, malheureusement je manque de temps et 24 heures sera trop court pour y arriver tout seul.

Merci par avance de votre aide.

Jarault

**jarault** · 14/04/2008, 18h08

Je suis vraiment pas doué, mais au moins j'essaye:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub Effacer_Tout2()
 
'Efface Les Achats
 
    For Each Cell In Range("B2:B151")
        Cell.Select
        If Cell <= Range("I1") +1 Then Application.Run "Effacer_Achats"
    Next Cell
 
    Application.ScreenUpdating = True
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub Effacer_Achats()
ActiveCell.ClearContents
ActiveCell.Offset(0, -1).ClearContents
ActiveCell.Offset(0, 1).ClearContents
ActiveCell.Offset(0, 2).ClearContents
ActiveCell.Offset(0, 3).ClearContents
ActiveCell.Offset(0, 4).ClearContents
ActiveCell.Offset(0, 5).ClearContents
ActiveCell.Offset(0, 6).ClearContents
End Sub

C'est nul mais çà marche, si quelqun à quelquechose de plus propre, je suis preneur

Jarault

**Gorfael** · 14/04/2008, 18h10

Salut jarault et le forum

Dans la case I1 se strouve la date du jour.
Dans la plage A2:H151 se trouve les données à effacer
Dans la plage B2:B151 se touve les dates qui servent de référence.
La macro doit effacer la ligne si la date est <= I1+1 (soit la date de demain),
si c'est le cas pour la première ligne, les cellules de B2 à H2 devront être éffacées, sinon la ligne reste intacte

Ce que je comprends : Dans le tableau A2:H151, si la cellule de la colonne B est inférieure ou égale à la valeur de I1+1, effacer les cellules de la ligne correspondante dans les colonnes A à H, sans supprimer les cellules.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test()
Dim Cel As Range
For Each Cel In Range("B2:B151")
    If Int(Cel) <= Int(Range("I1"))+ 1 Then _
      Range(Cel.Offset(0, -1), Cel.Offset(0, 6)).ClearContents
Next Cel
End Sub

A+
EDIT : ATTENTION les critères du descriptif (I1+1) et de l'exemple (I1) sont différents.
Si on peut, il vaut mieux éviter de faire des appels macros : ça ralentit et le gain est minime.
Call Nom_de_la_Macro me semble plus indiqué, mais chacun sa méthode.
Tu as un ScreenUpdating = True, mais j'ai pas vu le false

. Pour toutes les instruction qui modifient le fonctionnement d'excel, je gère systématiquement les erreurs, juste pour être sur que la macro remettra Excel dans la bonne configuration, même en cas d'erreur.
Il faut éviter l'usage des SELECT, qui sont bouffeurs de temps, et donc trouver un substitut à ActiveCell.

**Le Pierre** · 14/04/2008, 18h11

bonjour

essaye ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub Macro1()
    DateAeffacer = Cells(1, 9).Value
    Derligne = Range("A2").End(xlDown).Row
    For Lig = Derligne To 2 Step -1
        If DateAeffacer < Cells(Lig, 1).Value Then
            Range("A" & Lig & ":H" & Lig).Select
            Selection.Delete Shift:=xlUp
        End If
    Next Lig
End Sub

il va supprimer les cellules des colonnes A à H pour chaque ligne dont la date est supérieure à la date du jour.
à plus

**jarault** · 14/04/2008, 18h31

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test()
Dim Cel As Range
For Each Cel In Range("B2:B151")
    If Int(Cel) <= Int(Range("I1"))+ 1 Then _
      Range(Cel.Offset(0, -1), Cel.Offset(0, 6)).ClearContents
Next Cel
End Sub

Super çà marche super bien, par contre la macro pourrait être plus rapide en utilisant le principe de "Le Pierre", c'est à dire en partant du bas pour remonter car il arrive que je n'ai que quelques lignes de remplies et dans tous les cas il n'y a pas de lignes vides (les données viennent d'une requête access et sont regroupées les unes après les autres).

Jarault

**jarault** · 14/04/2008, 18h32

Envoyé par Le Pierre

bonjour

essaye ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub Macro1()
    DateAeffacer = Cells(1, 9).Value
    Derligne = Range("A2").End(xlDown).Row
    For Lig = Derligne To 2 Step -1
        If DateAeffacer < Cells(Lig, 1).Value Then
            Range("A" & Lig & ":H" & Lig).Select
            Selection.Delete Shift:=xlUp
        End If
    Next Lig
End Sub

il va supprimer les cellules des colonnes A à H pour chaque ligne dont la date est supérieure à la date du jour.
à plus

La macro ne tiend pas compte de la date et efface toutes les lignes, par contre le fait de partir du bas pour remonter accélère la macro dans ce cas précis.

**Le Pierre** · 14/04/2008, 19h10

s'il n'y a pas de date dans la cellule I1 ou si la condition n'est pas remplie (date en A..>date inscrite en I1), effectivement toutes les lignes seront effacées

voici mon fichier de test : http://cjoint.com/?eotjzq5MZR

à plus

**Gorfael** · 14/04/2008, 19h21

Salut jarault

par contre la macro pourrait être plus rapide en utilisant le principe de "Le Pierre", c'est à dire en partant du bas pour remonter

Le sens importe peu, dans le cas de ma nacro, puisqu'on ne supprime pas les cellules, on se contente de les effacer. la rapidité vient uniquement du nombre de cellules à contrôler

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test()
Dim Cel As Range
For Each Cel In Range([B2],[B2].End(xlDown))
    If Int(Cel) <= Int(Range("I1"))+ 1 Then _
      Range(Cel.Offset(0, -1), Cel.Offset(0, 6)).ClearContents
Next Cel
End Sub

C'est la même, sauf qu'on limite le nombre de cellules par le même type d'instruction que celui de Le Pierre.
Je n'utilise pratiquement jamais le "XlDown", son comportement dépendant de trop de facteur (état vide 1re et 2me cellule, cellules vides au milieu).
D'habitude, j'utilise : Range([B2],[B65536].End(xlup)), mais ne connaissant pas la structures des données, et ne sachant pas si B150 et B151 sont vides ou non, je me suis contenté d'utiliser la limite définie.
On pourrait rajouter le test d'une date en Cel :
If Int(Cel) <= Int(Range("I1"))+ 1 And isDate(cel) then
Mais pour moi, les cellules B2:B151 contenaient toutes des dates
A+

**jarault** · 14/04/2008, 23h26

Envoyé par Le Pierre

s'il n'y a pas de date dans la cellule I1 ou si la condition n'est pas remplie (date en A..>date inscrite en I1), effectivement toutes les lignes seront effacées

voici mon fichier de test : http://cjoint.com/?eotjzq5MZR

à plus

Ok je viens de comprendre pourquoi çà ne marchait pas, juste un problème de choix de date et de colonne (ton code cherche la date dans la colonne A, chez moi celle-ci est dans la colonne B)

J'en apprends tous les jours merci pour votre aide si précieuse.

Jarault

**jarault** · 16/04/2008, 12h08

Envoyé par Gorfael

Salut jarault
Le sens importe peu, dans le cas de ma nacro, puisqu'on ne supprime pas les cellules, on se contente de les effacer. la rapidité vient uniquement du nombre de cellules à contrôler

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test()
Dim Cel As Range
For Each Cel In Range([B2],[B2].End(xlDown))
    If Int(Cel) <= Int(Range("I1"))+ 1 Then _
      Range(Cel.Offset(0, -1), Cel.Offset(0, 6)).ClearContents
Next Cel
End Sub

C'est la même, sauf qu'on limite le nombre de cellules par le même type d'instruction que celui de Le Pierre.
Je n'utilise pratiquement jamais le "XlDown", son comportement dépendant de trop de facteur (état vide 1re et 2me cellule, cellules vides au milieu).
D'habitude, j'utilise : Range([B2],[B65536].End(xlup)), mais ne connaissant pas la structures des données, et ne sachant pas si B150 et B151 sont vides ou non, je me suis contenté d'utiliser la limite définie.
On pourrait rajouter le test d'une date en Cel :
If Int(Cel) <= Int(Range("I1"))+ 1 And isDate(cel) then
Mais pour moi, les cellules B2:B151 contenaient toutes des dates
A+

Ca marche du tonnerre merci beaucoup pour votre aide.

Jarault

Effacer des cellules en fonction de la date

Macros et VBA Excel

Discussions similaires

Partager

Partager