IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Selection de plage de date


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Homme Profil pro
    Inscrit en
    Mai 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Vienne (Limousin)

    Informations professionnelles :
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2012
    Messages : 30
    Par défaut Selection de plage de date
    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

  2. #2
    Membre expérimenté
    Profil pro
    Inscrit en
    Avril 2012
    Messages
    107
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2012
    Messages : 107
    Par défaut
    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")), )

  3. #3
    Membre averti
    Homme Profil pro
    Inscrit en
    Mai 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Vienne (Limousin)

    Informations professionnelles :
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2012
    Messages : 30
    Par défaut hélas...
    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

  4. #4
    Membre averti
    Homme Profil pro
    Inscrit en
    Mai 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Vienne (Limousin)

    Informations professionnelles :
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2012
    Messages : 30
    Par défaut
    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

  5. #5
    Membre averti
    Homme Profil pro
    Inscrit en
    Mai 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Vienne (Limousin)

    Informations professionnelles :
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2012
    Messages : 30
    Par défaut Youpi !!!
    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 !!

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2003] Formule pour automatiser une selection de plage selon 2 dates
    Par Chamalau dans le forum Macros et VBA Excel
    Réponses: 20
    Dernier message: 12/12/2013, 15h48
  2. verification valeur select pour verifier si date dépassée
    Par calitom dans le forum Général JavaScript
    Réponses: 10
    Dernier message: 31/03/2006, 17h14
  3. [CR]Aide sur les fonction de date et plage de date.
    Par Job dans le forum SAP Crystal Reports
    Réponses: 1
    Dernier message: 08/11/2005, 09h19
  4. [date] Recherche dans une plage de dates
    Par astro84 dans le forum Général JavaScript
    Réponses: 5
    Dernier message: 28/06/2005, 17h13
  5. Sélection d'une plage de dates
    Par Bouanda dans le forum MS SQL Server
    Réponses: 3
    Dernier message: 24/10/2004, 20h27

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo