Bonjour,
Je dois tri et extraire des données (365 jours avec un pas de temps de 10 mn...) selon plusieurs critères.
Un premier tri doit récupérer les données de janvier, février et décembre tous les jours sauf dimanche sur deux périodes de deux heures au choix selon le site.
Les périodes au choix sont 8h-10h et 18-20h ou 9-11 et 18-20h.
J'ai bricolé une macro qui me permet de réaliser ce tri et extraction.
mais sur plusieurs sites nouveaux, la période du matin n'est pas sur des heures rondes. Et là ça coince, ma macro ne permet pas de trier entre 8:30 et 10:30 par exemple.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41 Sub pointes() 'ok Dim i As Long Dim a, b, c, d As Long a = Application.InputBox("Sélectionnez l'heure de début de pointe du matin :", Type:=1) b = Application.InputBox("Sélectionnez l'heure de fin de pointe du matin :", Type:=1) c = Application.InputBox("Sélectionnez l'heure de début de pointe du soir :", Type:=1) d = Application.InputBox("Sélectionnez l'heure de fin de pointe du soir :", Type:=1) i = 2 j = 2 While Not IsEmpty(Cells(i, 1)) If Month(Cells(i, 1)) = 1 And Weekday(Cells(i, 1)) <> 1 And Hour(Cells(i, 1)) >= a And Hour(Cells(i, 1)) < b _ Or Month(Cells(i, 1)) = 1 And Weekday(Cells(i, 1)) <> 1 And Hour(Cells(i, 1)) >= c And Hour(Cells(i, 1)) < d _ Or Month(Cells(i, 1)) = 2 And Weekday(Cells(i, 1)) <> 1 And Hour(Cells(i, 1)) >= a And Hour(Cells(i, 1)) < b _ Or Month(Cells(i, 1)) = 2 And Weekday(Cells(i, 1)) <> 1 And Hour(Cells(i, 1)) >= c And Hour(Cells(i, 1)) < d _ Or Month(Cells(i, 1)) = 12 And Weekday(Cells(i, 1)) <> 1 And Hour(Cells(i, 1)) >= a And Hour(Cells(i, 1)) < b _ Or Month(Cells(i, 1)) = 12 And Weekday(Cells(i, 1)) <> 1 And Hour(Cells(i, 1)) >= c And Hour(Cells(i, 1)) < d _ Then Range(Cells(i, 1), Cells(i, 2)).Select Selection.Copy Range(Cells(j, 4), Cells(j, 5)) i = i + 1 j = j + 1 Else i = i + 1 End If Wend Range("D2:E2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Sheets("pointes").Select Range("A2:B2").Select ActiveSheet.Paste End Sub
J'ai testé une parade avec la concaténation heure: minutes
voici l'idée :
Pour que ça fonctionne j'ai modifier le type de l'inputbox en type 2
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 Sub concatener() Dim a, b, c, d As Long a = Application.InputBox("Sélectionnez l'heure de début de pointe du matin :", Type:=2) b = Application.InputBox("Sélectionnez l'heure de fin de pointe du matin :", Type:=2) If Hour(Cells(i, 1)) & ":" & Minute(Cells(i, 1)) >= a And Hour(Cells(i, 1)) & ":" & Minute(Cells(i, 1)) < b _ Then Cells(51, 3).Select Selection = "bonjour" Else Selection = "a demain" End If End Sub
Par contre quand j'insère la condition avec cette concaténation dans ma macro initiale ça ne marche pas. Il doit y avoir un conflit de type pour a et b et de déclaration de ces variables.
Je me permets de joindre mon fichier pour que ce soit plus explicite.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36 Sub pointesdemiheure() Dim i As Long Dim a, b, c, d As Long a = Application.InputBox("Sélectionnez l'heure de début de pointe du matin :", Type:=2) b = Application.InputBox("Sélectionnez l'heure de fin de pointe du matin :", Type:=2) 'c = Application.InputBox("Sélectionnez l'heure de début de pointe du soir :", Type:=2) 'd = Application.InputBox("Sélectionnez l'heure de fin de pointe du soir :", Type:=2) i = 2 j = 2 While Not IsEmpty(Cells(i, 1)) If Month(Cells(i, 1)) = 1 And Weekday(Cells(i, 1)) <> 1 And Hour(Cells(i, 1)) & ":" & Minute(Cells(i, 1)) >= a And Hour(Cells(i, 1)) & ":" & Minute(Cells(i, 1)) < b _ Then Range(Cells(i, 1), Cells(i, 2)).Select Selection.Copy Range(Cells(j, 4), Cells(j, 5)) i = i + 1 j = j + 1 Else i = i + 1 End If Wend Range("D2:E2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Sheets("pointes").Select Range("A2:B2").Select ActiveSheet.Paste End Sub
Je travaille d'abord sur la macro heure pointe, si ça marche je dupliquerai l'astuce sur la macro heure pleine hiver.
Merci d'avance pour le coup de pouce.
Partager