XL 2013 effacer une cellule si elle n'a pas le format aaaa-mm--jj

[lepigoennier]

Bonjour,

Après plusieurs recherches, je ne trouve pas réponse à mon besoin. Je dois effacer (et non pas supprimer) dans une colonne toutes les cellules qui ne sont pas des dates sous le format aaaa-mm-jj. Bien qu'on l'ait mentionné à plusieurs reprises, les gens continuent à mettre n'importe quelles données (autant texte que des formats de style mai 18 ou 05-18). Comment puis-je faire? J'ai bien trouvé comment effacer une cellule si elle contient un certain texte, mais pas le format.

Merci

 

[Victor21]

Bonjour, lepigeonnier.

Peut-être avec les macros Excel4 (LIRE.CELLULE), ou VBA, pouvez-vous effacer les valeurs erronées.
Mais la solution, c'est de prévenir les erreurs, et les concepteurs y ont pensé, et ont créé spécialement pour vous la validation de données :

 

[job75]

Bonsoir lepigeonnier, Patrick,

On peut aussi placer cette macro dans le code de la feuille concernée :

Private Sub Worksheet_Change(ByVal Target As Range)
With Range("A2:A" & Rows.Count) 'plage à adapter
    If Intersect(Target, .Cells) Is Nothing Then Exit Sub
    .NumberFormat = "yyyy-mm-dd"
    On Error Resume Next 'si aucune SpecialCell
    .SpecialCells(xlCellTypeConstants, 22).ClearContents 'valeurs non numériques
End With
End Sub

La plage traitée ici est la plage A2:A1048576.

A+

 

[Victor21]

Bonsoir, Gérard.

On peut également ajouter un test de cohérence sur une plage de dates : N° de série entre 36526 et 73051 par exemple, car 23 (ie) est numérique, mais probablement pas une date valide.
Non ?

 

[job75]

Re,

On peut également ajouter un test de cohérence sur une plage de dates : N° de série entre 36526 et 73051 par exemple

Oui bien sûr, donc entre 1/1/2000 et 1/1/2100 :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Range("A2:A" & Rows.Count) 'plage à adapter
r.NumberFormat = "yyyy-mm-dd"
Set r = Intersect(Target, r, UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'si aucune SpecialCell
Columns(1).Insert 'insertion de la colonne auxiliaire
For Each r In r.Areas
    r.Offset(, -1) = "=1/(RC[1]>=DATEVALUE(""1/1/2000""))/(RC[1]<DATEVALUE(""1/1/2100""))"
    r.Offset(, -1).SpecialCells(xlCellTypeFormulas, 16).Offset(, 1).ClearContents
Next
Columns(1).Delete 'suppression de la colonne auxiliaire
Application.EnableEvents = True 'réactive les évènements
End Sub

Bonne fin de soirée.

 

[job75]

Bonsoir lepigeonnier, Patrick, le forum,

J'ai testé la macro précédente sur 50 000 dates, une sur deux effacée => exécution en 16 secondes chez moi.

Bonne journée.