Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Macro pour filtrer une colonne de dates en fonction d'une plage horaire choisie - VBA

ibrahima

XLDnaute Nouveau
Bonjour Messieurs, Dames

Je vous expose mon problème, je cherche à partir de données brutes que j'ai trier par date/heure à permettre à l'utilisateur de ma future macro de choisir une plage exemple : de 08h à 12h par pas de 10 minutes (08h10 - 08h20 ..... 11h50-12h00 ) et d'afficher un tableau avec la plage sélectionnée et la colonne "Données" correspondantes.

Vous trouverez ci-joint ce que j'ai fais manuellement mais que je voudrai automatiser dans une macro pour n'importe quelle plage horaire et au mieux sans avoir à ajouter une colonne Heure car j'ai déjà une colonne date qui donne l'heure correspondant.

PS: je voudrai svp dans un premier temps une solution de codage sur VBA sachant que je me débrouille pour tout ce qui est sur la demande de l’utilisateur pour le choix de la plage

Merci d'avance !!
 

Pièces jointes

  • fichier_forum.xlsx
    1.4 MB · Affichages: 14

job75

XLDnaute Barbatruc
Bonjour ibrahima, bienvenue sur XLD,

Une solution VBA qui utilise le filtre avancé.

Voyez le fichier joint et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F2:G2]) Is Nothing Then Exit Sub
[E2] = "=(ROUND(MOD(C2,1),7)>=ROUND(F$2,7))*(ROUND(MOD(C2,1),7)<=ROUND(G$2,7))" 'critère
[A1].CurrentRegion.AdvancedFilter xlFilterCopy, [E1:E2], [I1:K1]
End Sub
Quand on compare des heures il faut prendre des précautions, d'où les ROUND(xxx,7).

A+
 

Pièces jointes

  • fichier_forum(1).xlsm
    1.3 MB · Affichages: 18

job75

XLDnaute Barbatruc
Dans ce fichier (2) la colonne "Heure" (inutile) a été supprimée :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2:F2]) Is Nothing Then Exit Sub
[D2] = "=(ROUND(MOD(A2,1),7)>=ROUND(E$2,7))*(ROUND(MOD(A2,1),7)<=ROUND(F$2,7))" 'critère
[A1].CurrentRegion.AdvancedFilter xlFilterCopy, [D1:D2], [H1:I1]
End Sub
 

Pièces jointes

  • fichier_forum(2).xlsm
    913.5 KB · Affichages: 20

ibrahima

XLDnaute Nouveau
Bonjour @job75,
Merci c'est parfait c'est exactement ce que je voulais j'aimerais bien avoir une explication si possible sur les Round et mod ensemble cela m'a l'air vraiment puissant ça ne prend qu'une ligne pour faire ce que je veux c'est vraiment génial !
bonne journée à vous !
 

ibrahima

XLDnaute Nouveau
et j'ajoute deux dernières questions questions : pour le Target comment choisir la plage que l'on veut tester ?
et pour personnaliser cette fonction qu'est ce que je peux mettre en variable pour changer les plages horaire de heure début et fin .

Merci d'avance pour votre patience !
 

chris

XLDnaute Barbatruc
Bonjour à tous

La plage horaire est à renseigner comme sur l'exemple en E2:F2 : le code l'interprète en
VB:
D1:D2

La plage à filtrer est le tableau partant de A1 jusqu'à rencontrer une ligne ou colonne entièrement vide ([A1].CurrentRegion)
La plage d'extraction correspond aux colonnes H et I dont les titres doivent être similaires à ceux de la plage filtrée

Pour les fonctions, le plus simple est de consulter l'aide en ligne

Le filtre avancé est très puisant. POur info, sur 2016 tu peux aussi faire la même chose sans VBA PowerQuery intégré
 

job75

XLDnaute Barbatruc
Bonjour ibrahima, chris,

Pour les questions du post #4 :

- la fonction MOD(xxx;1) renvoie la partie décimale, c'est à dire l'heure, de XXX

- ROUND(YYY;7) permet de supprimer les décimales au-delà de 7 car pour une même heure affichée celles-ci peuvent êre différentes.

Cela arrive parfois (pas toujours) quand on incrémente les heures en tirant les cellules vers le bas.

A+
 

job75

XLDnaute Barbatruc
Pour la question du post #5 ce fichier (3) permet de choisir les dates de début et de fin :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2:F2,E5:F5]) Is Nothing Then Exit Sub
[D2] = "=(A2>=INT(E$2))*(A2<INT(F$2)+1)*(ROUND(MOD(A2,1),7)>=ROUND(E$5,7))*(ROUND(MOD(A2,1),7)<=ROUND(F$5,7))" 'critère
[A1].CurrentRegion.AdvancedFilter xlFilterCopy, [D1:D2], [H1:I1]
End Sub
 

Pièces jointes

  • fichier_forum(3).xlsm
    914 KB · Affichages: 23

ibrahima

XLDnaute Nouveau
Re Bonjour à tous ( @chris et @job75 ),

Je vous remercie pour vos réponses claires à tous les 2 je comprends ce que fais maintenant ces lignes de codes chris merci pour l'info je vais y jeter un coup d'œil.
et @job75 je suis gêné je penses m'être mal exprimé je voudrai en complément de ce que tu as ajouté dans le post #8 mettre les valeurs des heures de début et de fin dans une variable afin que je puisse coder par la suite un "inputbox" qui va demander à l'utilisateur d'entrer les valeurs des heures et que le Tableau se remplissent automatiquement.


VB:
'Exemple de variables :

début = 08:00:00
Fin = 12:00:00

'comme ça je pourrais faire :
                                              début= inputbox ("veuillez entrez la date de début : " , "date de début" )
                                              Fin= inputbox ("veuillez entrez la date de Fin : " , "date de Fin ")
j'espère que je suis claire n'hésitez pas à me demander si vous avez besoins de plus d'info
Merci encore !
 
Dernière édition:

job75

XLDnaute Barbatruc
Je ne vois pas en quoi des InputBoxes sont plus intéressantes que des cellules dans la feuille mais bon voyez ce fichier (4) :
VB:
Sub Choisir()
Dim n As Byte, x$
For n = 0 To 1 '2 passages
    x = ""
    Do While Not (x Like "#:##" Or x Like "##:##") Or Not IsDate(x)
        x = InputBox("Heure de " & IIf(n, "fin", "début") & " au format h:mm :", "Choisir", x)
        If x = "" Then Exit Sub
    Loop
    ThisWorkbook.Names.Add IIf(n, "Fin", "Début"), CDate(x) 'noms définis
Next
[D2] = "=(ROUND(MOD(A2,1),7)>=ROUND(Début,7))*(ROUND(MOD(A2,1),7)<=ROUND(Fin,7))" 'critère
[A1].CurrentRegion.AdvancedFilter xlFilterCopy, [D1:D2], [E1:F1]
End Sub
 

Pièces jointes

  • fichier_forum(4).xlsm
    915.4 KB · Affichages: 29

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…