XL 2019 Supprimer les lignes lorsqu'une heure dépasse une plage

[Jujulien2208]

Bonjour,

Je suis très novice dans les macros Excel et j'espère que vous pourrait apporter votre aide à mon problème.

Je m'explique, je dispose d'un tableau Excel avec des valeurs de luminosité en lux prise toute les 5 min par un capteur.

Je souhaite garder que les valeurs qui ont été récupérées de 8h à 20h et supprimer le reste.

Ma question est la suivante : comment faire avec les macros pour réussir à le faire ?

Je vous remercie par avance.

 

[sylvanu]

Bonsoir Jujulien, et bienvenu sur XLD,
Sans fichier test difficile de répondre à part être évasif.
La macro va dépendre de l'organisation de vos données.

 

[job75]

Bonsoir jujulien2208, sylvanu,

Quand il s'agit de filtrer ou comparer des heures il faut prendre des précautions à causes des dernières décimales.

Voyez le fichier joint et cette macro dans le code de la feuille "Filtre" :

Private Sub Worksheet_Activate()
Dim deb#, fin#, critere As Range, mem
deb = TimeValue("8:00")
fin = TimeValue("20:00")
Application.ScreenUpdating = False
Range("A2:B" & Rows.Count).ClearContents 'RAZ
With Sheets("BDD").[A1].CurrentRegion.Resize(, 2)
    Set critere = .Cells(1, 3).Resize(2) 'C1:C2
    mem = critere.Formula 'mémorisation
    critere(1) = ""
    critere(2) = "=AND(A2>" & Replace(deb - 1 / 1000000, ",", ".") & ",A2<" & Replace(fin + 1 / 1000000, ",", ".") & ")" 'formule du critère
    .AdvancedFilter xlFilterCopy, critere, [A1:B1] 'copie le filtre avancé sur A1:B1
    critere = mem 'état initial
End With
End Sub

Elle se déclenche quand on active la feuille.

A+

 

[job75]

Autre solution dans ce fichier (2) en comparant des chaînes de textes de 5 caractères :

Private Sub Worksheet_Activate()
Dim deb$, fin$, critere As Range, mem
deb = "08:00"
fin = "20:00"
Application.ScreenUpdating = False
Range("A2:B" & Rows.Count).ClearContents 'RAZ
With Sheets("BDD").[A1].CurrentRegion.Resize(, 2)
    Set critere = .Cells(1, 3).Resize(2) 'C1:C2
    mem = critere.Formula 'mémorisation
    critere(1) = ""
    critere(2) = "=AND(TEXT(A2,""hh:mm"")>=""" & deb & """,TEXT(A2,""hh:mm"")<=""" & fin & """)"  'formule du critère
    .AdvancedFilter xlFilterCopy, critere, [A1:B1] 'copie le filtre avancé sur A1:B1
    critere = mem 'état initial
End With
End Sub

Bonne nuit.