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.

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
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.

J'ai testé une parade avec la concaténation heure: minutes
voici l'idée :

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
Pour que ça fonctionne j'ai modifier le type de l'inputbox en type 2

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.

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 me permets de joindre mon fichier pour que ce soit plus explicite.
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.