Analyse de tableau et affichage de résultats suivant certains critères

[Polo34]

Bonjour le FORUM et bonjour à tous,

De nouveau vers vous pour me dépatouiller d'un pb que je n'arrive pas bien à résoudre en VBA.
Je vous joins un fichier exemple qui vous parlera.
En fait je veux extraire en VBA, des données d'un tableau et les afficher suivant des critères particuliers.
- durée d'évènement
- survenus dans une plage horaire précise
- durée >= 12mn

Merci de votre aide

Polo34

 

[jpb388]

Re : Analyse de tableau et affichage de résultats suivant certains critères

Bonjour
Regardez si cela vous va
a+
jp

 

[Polo34]

Re : Analyse de tableau et affichage de résultats suivant certains critères

Bonjour
Regardez si cela vous va
a+
jp

Bonsoir jpb388,

Merci pour ce travail que je vais étudier avec attention.

Pour répondre à votre question, 12mn correspond à 5% de 4h. Toutes les activités ou somme d'activités ayant dépassées 12mn pendant une plage horaire définie impactent donc ce taux: Soit une seule activité, soit la somme des durées de plusieurs activités durant une plage. Dans le tableau l'activité 9832604 impacte donc le taux ainsi que la somme des durées des activités 9925470, 9925507 et 9926154. Par contre si le taux à été impacté le même jour sur une même plage, l'impacte sur le taux n'est comptabilisé qu'une seule fois.
Les autres activités ayant dépassées 12mn n'étant pas intervenues dans leas plages définies, ne sont pas comptabilisées.
Mon pb était d'ailleurs situé dans ce calcul un peu délicat ainsi que regrouper les activités survenues durant une même plage.

Merci encore pour votre réponse
A+
Polo34

 

[Polo34]

Re : Analyse de tableau et affichage de résultats suivant certains critères

bonjour ,

Votre proposition fonctionne parfaitement et j'ai résolu le pb d'incrémentation des activités >= 12mn.
Par contre j'ai un souci concernant des activités comprisent entre 21h et 1h. Car avec la fonction TimeValue, plage prend la valeur "1 à 5h" puis "17 à 21" alors que dans ce cas l'activité ne doit pas etre enregistrée.
Je pense que cela vient de la mise en forme des valeurs dates.
Je recherche de mon coté le moyen de détourner ce pb. Si vous avez une idée, je suis preneur

Merci d'avance

Polo34

 

[jpb388]

Re : Analyse de tableau et affichage de résultats suivant certains critères

Bonjour
Remplacer l'ancienne par la nouvelle
elle a permis de révéler que 9926154 ne doit pas entrer dans votre liste car la journée passe au 16

tenez moi au courant
a+
jp

 Sub CalculListe()
 With Application
        .Calculation = xlManual
        .MaxChange = 0.001
    End With
    Range("b40:f" & Range("f65536").End(xlUp).Offset(1, 0).Row).ClearContents
Dim L1%, Plage$, Jour As Date, Debut As Date, Fin As Date
Dim PH1Deb As Date, PH2Deb As Date, PH1Fin As Date, PH2Fin As Date
L1 = 4
Jour = Empty
Do
' initilisation
Plage = ""
Debut = CDate(Range("b" & L1)) + CDate(Range("c" & L1))
Fin = CDate(Range("d" & L1)) + CDate(Range("e" & L1))
PH1Deb = CDate(Range("b" & L1)) + TimeValue(Range("j4") & ":00:00")
PH1Fin = CDate(Range("b" & L1)) + TimeValue(Range("k4") & ":00:00")
PH2Deb = CDate(Range("d" & L1)) + TimeValue(Range("j5") & ":00:00")
PH2Fin = CDate(Range("d" & L1)) + TimeValue(Range("k5") & ":00:00")
If PH1Fin < PH1Deb Then PH1Fin = PH1Fin + 1
If PH2Fin < PH2Deb Then PH2Fin = PH2Fin + 1

' recherche Plage Horaire et jour
If Debut >= PH1Deb And  Fin <= PH1Fin Then
        Plage = Range("j4") & " à " & Range("k4") & " h"
End If
If Debut >= PH2Deb And  Fin <= PH2Fin Then
        Plage = Range("j5") & " à " & Range("k5") & " h"
End If
' inscription
If Plage <> "" Then
Select Case Range("b" & L1) = Jour
    Case True
        Select Case Range("e65536").End(xlUp) = Plage
            Case True
                Range("b65536").End(xlUp) = Range("b65536").End(xlUp).Text & ", " & Range("f" & L1).Text
                Range("b65536").End(xlUp).Offset(0, 2) = Range("b65536").End(xlUp).Offset(0, 2) + Range("g" & L1)
                Jour = Range("b" & L1)
            Case False
                Range("b65536").End(xlUp).Offset(1, 0) = Range("f" & L1)
                Range("b65536").End(xlUp).Offset(0, 1) = Plage
                Range("b65536").End(xlUp).Offset(0, 2) = Range("g" & L1)
                Jour = Range("b" & L1)
        End Select
    Case False
        Range("b65536").End(xlUp).Offset(1, 0) = Range("f" & L1)
        Range("b65536").End(xlUp).Offset(0, 1) = Plage
        Range("b65536").End(xlUp).Offset(0, 2) = Range("g" & L1)
        Jour = Range("b" & L1)
End Select
End If
L1 = L1 + 1
Loop Until Range("g" & L1) = ""
    With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
    End With

End Sub

 

[Polo34]

Re : Analyse de tableau et affichage de résultats suivant certains critères

Bonsoir jpb388
et merci encore pour votre aide préciseuse qui m'a permis de bien avancer dans mon projet.

Au plaisir j'espère dans le Forum

A+

Polo34