suppression de données entre deux dates

[philmaure]

Bonjour à tous,

Je souhaite supprimer des données entre deux dates sélectionnée.
J'ai expliqué au maximum le pb dans le fichier
Merci à tous par avance pour vos solutions
Cdlt
philippe

 

[ROGER2327]

Re : suppression de données entre deux dates

Bonsoir philmaure

Une proposition dans le classeur joint.​

ROGER2327
#5259

Samedi 7 Merdre 138 (Nativité de Monsieur Plume, propriétaire - fête Suprême Quarte)
5 Prairial An CCXIX, 9,5262h
2011-W21-2T22:51:46Z

 

[philmaure]

Re : suppression de données entre deux dates

Bonsoir Roger et merci pour la solution,

ca me parait pas mal excepté que quelque soit la date de debut il prend toujours le 02/05
je ne parviens pas à trouver la faille dans la macro.
Cdlt

 

[ROGER2327]

Re : suppression de données entre deux dates

Re…

Bonsoir Roger et merci pour la solution,

ca me parait pas mal excepté que quelque soit la date de debut il prend toujours le 02/05
je ne parviens pas à trouver la faille dans la macro.
Cdlt

Étonnant ! Je viens de rouvrir le classeur déposé et de tester avec 3/5 comme date de début et 5/5 comme date de fin : il me reste les données du 2/5, 6/5, 7/5 et 8/5.

J'ai par contre commis une erreur dans les lignes de texte, où j'ai écris tmp1 au lieu de de, et j'ai oublié un On Error GoTo 0

Code rectifié :

Option Explicit

Public debut As Date, fin As Date

Sub mise_a_jour()
Dim tmp1$, tmp2 As Date, msg1$, msg2$
  With ActiveSheet 'feuille de travail
    'param /defaut
    debut = .Range("BE1").Value
    fin = .Range("BE2").Value
    'questions
    On Error GoTo E
    tmp1 = InputBox("Confimez la date de départ à supprimer", "Actualisation", debut)
    If tmp1 = "" Then Exit Sub
    msg1 = "date de départ au format jj/mm/aaaa": msg2 = "Actualisation": tmp2 = debut
    debut = CDate(tmp1)
    tmp1 = InputBox("Confimez la date de fin à supprimer", "Actualisation", fin)
    If tmp1 = "" Then Exit Sub
    msg1 = "date de fin au format jj/mm/aaaa": msg2 = "Actualisation": tmp2 = fin
    fin = CDate(tmp1)
    On Error GoTo 0
    .Range("BF1").Value = debut
    .Range("BF2").Value = fin
    toto .Name 'nom de la feuille de travail
  End With
Exit Sub
'
E:  'gestion d'erreurs
  tmp1 = InputBox(msg1, msg2, tmp2)
  If tmp1 = "" Then Exit Sub
  Resume
End Sub

Sub toto(sh$)
Dim i&, j&, k&, h&, g&, d&, clef&, oDat, sDat()
Dim DMin As Date, DMax As Date
'===== description de la plage de données =====
  h = 1     'n° de la première (ligne de titre)
  g = 1     'rang de la première colonne
  d = 5     'rang de la dernière colonne
  clef = 1  'rang de la colonne de référence
'==============================================
  oDat = tata(sh, h, g, d, clef) 'extraction des données
  If Not IsEmpty(oDat) Then
    DMin = debut  'date de début
    DMax = fin    'date de fin
    k = 1
    ReDim sDat(1 To UBound(oDat, 1), 1 To 1 + d - g)
    For j = 1 To 1 + d - g: sDat(k, j) = oDat(k, j): Next
    For i = 2 To UBound(oDat, 1)
      If DMin > oDat(i, clef) Or oDat(i, clef) > DMax Then
        k = k + 1
        For j = 1 To 1 + d - g: sDat(k, j) = oDat(i, j): Next
      End If
    Next i
    Sheets(sh).Cells(h, g).Resize(UBound(oDat, 1), 1 + d - g).Value = sDat 'restitution des données sélectionnées
  End If
End Sub

Function tata(sh$, h&, g&, d&, clef&)
Dim i&, oDat
  With Sheets(sh)
    i = .Cells(.Rows.Count, clef).End(xlUp).Row
    If i > h Then
      oDat = .Range(.Cells(h, d), .Cells(i, g)).Value
    End If
  End With
  tata = oDat
End Function

​

ROGER2327
#5260

Samedi 7 Merdre 138 (Nativité de Monsieur Plume, propriétaire - fête Suprême Quarte)
5 Prairial An CCXIX, 9,7575h
2011-W21-2T23:25:05Z

 

[philmaure]

Re : suppression de données entre deux dates

bonjour,
Merci pour la solution
Effectivement cela supprime bien les dates sélectionnée mais les dates restantes sont désormais au format anglais.
Cdlt
philippe

 

[laetitia90]

Re : suppression de données entre deux dates

bonjour philmaure, ROGER

peut être plus simple en utilisant un user..plus de possibilitées???

 

[philmaure]

Re : suppression de données entre deux dates

Re,
cette solution est super aussi mais j'ai toujours le pb de format date des valeurs restantes qui se modifie après réalisation de la macro.
Je met donc :
Dim Ce As Variant
Columns("a:a").Select
For Each Ce In Selection
If IsDate(Ce.Cells.Value) Then
Ce.Cells.Value = Format(Ce.Cells.Value, "mm/dd/yyyy")
End If
Next

cela fontionne mais c'est super long a tourner

un grandd merci pour ton aide
Cdlt

 

[philmaure]

Re : suppression de données entre deux dates

pour info lorsqu'on refait une 2 ème fois la macro la date redevient en français. Je ne vois vraiment pas à quel moment la macro modifie le format date !!!!
Cdlt

 

[laetitia90]

Re : suppression de données entre deux dates

re, bizarre j'ai pas ce pb
pas le pb egalement avec le code de l'ami Roger
dans windows panneau de configuration
options regionnales & lingui...
tu es sous quel format ???

 

[philmaure]

Re : suppression de données entre deux dates

oui c'est vraiment bizarre, tout est bien en Français
cdlt

 

[laetitia90]

Re : suppression de données entre deux dates

re,si j'ai un moment je chercherais pourquoi!!!
en depannage modifie cette partie
debut code
x = x + 1
t(i, 1) = Format(t(i, 1), "dd/mm/yyyy")'rajoute
For c = 1 To 5: t3(x, c) = t(i, c): Next c
End If
Next i
Range("a2:e" & Cells(Rows.Count, 1).End(xlUp).Row).Clear
[a2].Resize(x, 5) = t3: Unload Me

si cela resoud provisoirement le pb..

ps ta version excel francaise ou anglaise??

 

[philmaure]

Re : suppression de données entre deux dates

merci pour ton aide mais je ne m'en sors pas.
Avec ton code, j'ai le message variable non définie et il pointe sur le X
Je vais essayer demain sur mon pc de bureau. Si cela fonctionne pour toi, j'ai des chances que cela fontionnera également sur mon pc prof.
Je mettrai un post pour dire ce que cela donne.
encore un grand merci à vosu deux et bonne journée
philmaure

 

[job75]

Re : suppression de données entre deux dates

Bonjour philmaure, Roger, laetitia,

Mon grain de sel (tardif) avec un petit coup de filtre élaboré (avancé) :

Sub mise_a_jour()
Dim debut$, fin$, plage As Range
'---dates---
1 debut = InputBox("Date de départ à supprimer :", "Actualisation")
If debut = "" Then Exit Sub
If Not IsDate(debut) Then GoTo 1
2 fin = InputBox("Date de fin à supprimer :", "Actualisation")
If fin = "" Then Exit Sub
If Not IsDate(fin) Then GoTo 2
[BF1] = Application.Min(CDate(debut), CDate(fin))
[BF2] = Application.Max(CDate(debut), CDate(fin))
'---sauvegarde (facultative)---
Sheets("Feuil1").Cells.Copy Sheets("Feuil2").Cells
'---filtre élaboré---
Application.ScreenUpdating = False
On Error Resume Next 'si tout est masqué
Set plage = Range("A1:E" & [A65536].End(xlUp).Row)
[F2].Formula = "=AND(A2>=BF$1,A2<=BF$2)" 'critère
plage.AdvancedFilter xlFilterInPlace, [F1:F2]
plage.Offset(1).Resize(plage.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete xlUp
plage.AdvancedFilter xlFilterInPlace, ""
[F2] = ""
Application.ScreenUpdating = True
If Err Then MsgBox "Aucune date supprimée..."
End Sub

Fichier joint.

A+

 

[philmaure]

Re : suppression de données entre deux dates

Bonjour Job,

Ca fonctionne nickel.
Un grand merci à vous trois et bonne journée très ensoleillée.
Cdlt
Philmaure

 

[job75]

Re : suppression de données entre deux dates

Re,

Pour le fun, si l'on veut que le message final indique le nombre de dates supprimées.

J'ai fait attention à l'orthographe des pluriels 😎

Voyez l'aide VBA pour l'utilisation de la fonction Switch.

A+