Selection de plage de date

**titibou** · 28/06/2012, 09h49

Bonjour à tous,

je m'adresse une nouvelle fois à vous dans le but d'éclaircir mes pensées...
Je recherche le moyen de selectionner un plage de cellule, repérées par leur date et heure (dans la même cellule), tout en ayant la possibilité de sortir un partie de cette plage.

Pour le moment, j'ai réalisé un bout de code qui me permet de selectionner un plage de cellule seulement en fonction de la date, il me manque la précision sur les heures pour laquelle je pensait opérer par un format Byte.

Pour le reste je ne saurais comment restreindre mes données...

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit
 
Private Sub CommandButton1_Click()
'Sub Init_LstCpt()
 
    Dim DateDebut As Date
    Dim DateFin As Date
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim k As Integer
    Dim Total1 As Double
    Dim Total2 As Double
    Dim Total3 As Double
    Dim Total4 As Double
    Dim Valeur1 As Date
    Dim Valeur2 As Date
 
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
 
    Set WS1 = ThisWorkbook.Worksheets("Feuil1")
    Set WS2 = ThisWorkbook.Worksheets("Feuil2")
     WS2.Cells.ClearContents
 
 
    DateDebut = TextBox1 'Valeur de date sous la forme jj/mm/aaaa
    DateFin = TextBox2 'Valeur de date sous la forme jj/mm/aaaa
 
 
    With WS1
 
        .Cells(1, 1).AutoFilter Field:=2, Criteria1:="<=" & CDec(DateFin), _
            Operator:=xlAnd, Criteria2:=">=" & CDec(DateDebut)
        On Error GoTo 1
        .Cells(1, 1).CurrentRegion.Copy Destination:=WS2.Cells(1, 1)
        On Error GoTo 0
    End With
 
 
 
    With WS2
 
        k = .Cells(.Rows.Count, 1).End(xlUp).Row
        If k < 2 Then
            MsgBox "Aucun resultat"
            GoTo 1
        End If
        Total1 = WorksheetFunction.Sum(.Range(.Cells(2, 3), .Cells(k, 3)))
        Cells(6, 9).Select     'permet de faire la moyenne sur la colonne sur la plage de date sélectionnée
    ActiveCell.Value = Total1 / k
        Total2 = WorksheetFunction.Sum(.Range(.Cells(2, 4), .Cells(k, 4)))
        Cells(7, 9).Select      'permet de faire la moyenne sur la colonne sur la plage de date sélectionnée
    ActiveCell.Value = Total2 / k
        Total3 = WorksheetFunction.Sum(.Range(.Cells(2, 5), .Cells(k, 5)))
        Cells(8, 9).Select      'permet de faire la moyenne sur la colonne sur la plage de date sélectionnée
    ActiveCell.Value = Total3 / k
        Total4 = WorksheetFunction.Sum(.Range(.Cells(2, 6), .Cells(k, 6)))
        Cells(9, 9).Select      'permet de faire la moyenne sur la colonne sur la plage de date sélectionnée
    ActiveCell.Value = Total4 / k
    End With
 
1
    WS1.Cells(1, 1).AutoFilter
 
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 
 
 
 
 
 
End Sub

Donc si jamais des idées vous viennent, n'hésitez pas !!!

Merci d'avance

**AlphaScorpi** · 28/06/2012, 11h10

Tu n'as pas besoin de changer ton filtre, si tu converti en decimale 28/06/2012 tu vas obtenir : 41088

Si tu converti en decimale 28/06/2012 11:05:43 tu vas obtenir 41088,4623032407

Sachant cela, il est possible d'appliquer un filtre pour les opérations effectuées le 28/06/2012 entre 15h et 18h :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.Cells(1, 1).AutoFilter Field:=2, Criteria1:="<=" & CDec(CDate("28/06/2012  18:00:00")), _
            Operator:=xlAnd, Criteria2:=">=" & CDec(CDate("28/06/2012  15:00:00")), )

**titibou** · 05/07/2012, 12h38

Merci de ta participation AlphaScorpi,

j'avais déjà tenté une sélection de cette manière, mais cela n'abouti à aucun résultat correct...

De plus comme je vais passer par un UserForm avec TextBox, j'étais tenté de faire la modification durant le "transfert" TextBox -> macro, d'où l'idée d'utiliser CByte qui convertie les dates en nombres ###,###

Mais je ne suis arrivé à aucun résultat pour le moment

**titibou** · 30/07/2012, 10h57

Hello !!!
je pensa avoir bien avancé !! sur mes feuilles, je peux désormais calculer mes moyennes en fonction des dates que je rentre.
Cependant, j'ai un peu de mal à retranscrire le tout sur mon fichier "de travail"...
Si une bonne âme pouvait m'aider, je cherche à insérer ce code sur plusieurs feuille dans un même classeur, mais pour l'instant je n'arrive à rien...

Merci d'avance

Ci-dessous le code fonctionnel avec les données en Feuil1

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
Option Explicit
 
Private Sub CommandButton1_Click()
'Sub Init_LstCpt()
 
    Dim DateDebut As String
    Dim DateFin As String
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim k As Integer
    Dim Total1 As Double
    Dim Total2 As Double
    Dim Total3 As Double
    Dim Total4 As Double
    Dim Valeur1 As Date
    Dim Valeur2 As Date
 
 
    Set WS1 = ThisWorkbook.Worksheets("Feuil1")
    Set WS2 = ThisWorkbook.Worksheets("Feuil2")
     WS2.Cells.ClearContents
 
 
    DateDebut = CVar(TextBox1) 'Valeur de date sous la forme jj/mm/aaaa
    DateFin = CVar(TextBox2) 'Valeur de date sous la forme jj/mm/aaaa
 
 
  '  DateDebut = "07/26/2011  12:39:00"
  '  DateFin = "07/26/2011  13:00:00"
 
 'dsgtzrethz
    With WS1
 
    Cells(1, 1).AutoFilter Field:=2, Criteria1:=">=" & DateDebut, _
            Operator:=xlAnd, Criteria2:="<=" & DateFin
       On Error GoTo 1
      .Cells(1, 1).CurrentRegion.Copy Destination:=WS2.Cells(1, 1)
        On Error GoTo 0
    End With
 
 
    'Columns("B:B").Select
    'Selection.AutoFilter
    'Selection.AutoFilter Field:=1, Criteria1:=">=" & DateDebut, Operator _
    '    :=xlAnd, Criteria2:="<=" & DateFin
 
 
 
 
 
    With WS2
 
        k = .Cells(.Rows.Count, 1).End(xlUp).Row
        If k < 2 Then
            MsgBox "Aucun resultat"
            GoTo 1
        End If
        Total1 = WorksheetFunction.Sum(.Range(.Cells(2, 3), .Cells(k, 3)))
        Cells(6, 9).Select
    ActiveCell.Value = Total1 / k
        Total2 = WorksheetFunction.Sum(.Range(.Cells(2, 4), .Cells(k, 4)))
        Cells(7, 9).Select
    ActiveCell.Value = Total2 / k
        Total3 = WorksheetFunction.Sum(.Range(.Cells(2, 5), .Cells(k, 5)))
        Cells(8, 9).Select
    ActiveCell.Value = Total3 / k
        Total4 = WorksheetFunction.Sum(.Range(.Cells(2, 6), .Cells(k, 6)))
        Cells(9, 9).Select
    ActiveCell.Value = Total4 / k
    End With
 
1
    WS1.Cells(1, 1).AutoFilter
 
 
 
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 
 
 
End Sub
 
Private Sub CommandButton2_Click()
    Unload UserForm1
End Sub
 
 
 
Private Sub TextBox1_Terminate()
    Dim Valeur1 As Date
    TextBox1.MaxLength = 17 'nb caractères maxi autorisé dans le textbox
    Valeur1 = TextBox1
End Sub
 
 
Private Sub TextBox2_Terminate()
Dim Valeur2 As Date
    TextBox2.MaxLength = 17 'nb caractères maxi autorisé dans le textbox
    Valeur2 = TextBox2
 
 
End Sub

**titibou** · 31/07/2012, 09h38

Voilà je pense avoir résolu mon problème !!

Je suis passé par une approche différente que celle du filtre automatique.

Je laisse le code si ça peut intéresser quelqu'un !!!

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Sub Total()
 
DateCherchée = InputBox("Date cherchée ! Format jj/mm/aaaa hh:mm:ss", "", Range("B2"))
If DateCherchée = "" Then Exit Sub
Ligne = 2
ColonneRecherche = 2
'DAteCellule = Cells
'On décompose "DateCherchée" qui est sous forme de texte, afin de le re concaténer sous la forme d'une vrai date
DD = Day(DateCherchée)
MM = Month(DateCherchée)
YYYY = Year(DateCherchée)
HH = Hour(DateCherchée)
MIM = Minute(DateCherchée)
SS = Second(DateCherchée)
 
Date_ = DateValue(DD & "/" & MM & "/" & YYYY)
Heure_ = TimeValue(HH & ":" & MIM & ":" & SS)
DateCherchée = Date_ + Heure_
 
Nb_Lignes_max = Range("B2").End(xlDown).Row         'Où "B2" est la colonne sur laquelle sont indiquées les dates
 
'Boucle sur les dates avec passage à la ligne suivante...
While DateCherchée <> Cells(Ligne, ColonneRecherche) _
    And Ligne <= Nb_Lignes_max
    Ligne = Ligne + 1
Wend
 
If Ligne > Nb_Lignes_max Then       'Message d'alerte si dépassement de la plage de date
    MsgBox ("Valeur non trouvée !")
Else
    MsgBox (Ligne)      'Numéro de la ligne où a été trouvé le résultat
End If
 
PremiereLigne = Ligne
 
''''''''''''''''''''''''''''''''
 
DateCherchée = InputBox("Date cherchée ! Format jj/mm/aaaa hh:mm:ss", "", Range("B2"))
If DateCherchée = "" Then Exit Sub
Ligne = PremiereLigne       'La ligne de départ est la ligne où est marquée
                '"DateCherchée" du Sub précédent
ColonneRecherche = 2
 
 
DD = Day(DateCherchée)
MM = Month(DateCherchée)
YYYY = Year(DateCherchée)
HH = Hour(DateCherchée)
MIM = Minute(DateCherchée)
SS = Second(DateCherchée)
 
Date_ = DateValue(DD & "/" & MM & "/" & YYYY)
Heure_ = TimeValue(HH & ":" & MIM & ":" & SS)
DateCherchée = Date_ + Heure_
 
Nb_Lignes_max = Range("B2").End(xlDown).Row
 
While DateCherchée <> Cells(Ligne, ColonneRecherche) _
    And Ligne <= Nb_Lignes_max
    Ligne = Ligne + 1
Wend
 
If Ligne > Nb_Lignes_max Then
    MsgBox ("Valeur non trouvée !")
Else
    MsgBox (Ligne)
End If
 
DerniereLigne = Ligne
 
'''''''''''''''''''''''''''''''''''
'On cache les lignes Antérieures à la Date de Début
 
    Ligne_Départ = 2
    Ligne_Fin = PremiereLigne - 1        'Correspond au numéro de ligne renvoyé par la MsgBox1
    Cellules = Ligne_Départ & ":" & Ligne_Fin
    Rows(Cellules).Hidden = True
 
 'On cache les lignes Postérieures à la Date de Fin
 
    Ligne_Départ = DerniereLigne          'Correspond au numéro de ligne renvoyé par la MsgBox2
    Ligne_Fin = Range("B2").End(xlDown).Row
    Cellules = Ligne_Départ & ":" & Ligne_Fin
    Rows(Cellules).Hidden = True
End Sub

Bonne continuation !!

Selection de plage de date

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager