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

Jujulien2208 · 26 Janvier 2022

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 · 31 Janvier 2022

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 · 31 Janvier 2022

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" :

VB:

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 · 31 Janvier 2022

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

VB:

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.

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

Jujulien2208

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires