XL 2010 EXTRAIRE UNE SERIE VARIABLE AVEC MOYENNE

jojo4738

XLDnaute Nouveau
Bonjour,
variante et complément de la discussion
"REPERER UNE SUITE DE CHIFFRES DANS UNE LIGNE" sur laquelle les contributions de Sousous, Mapomme et Job75 m'ont aidé. Je suis parti sur la base de la proposition de Mapomme (voir feuille jointe).
Je demandais votre aide pour "extraire de ce tableau TOUTES LES SUITES de 8 heures consécutives dont la valeur du taux est supérieur à 100 par exemple". En fait j'avais mal interprété l' exigence. Il fallait repérer sur ce tableau à 2 lignes( date/heure et valeur du relevé) et 8760 colonnes (365 jours x 24 heures) les séries de 8 données consécutives dont LA MOYENNE du taux est > à un nombre variable (100,120, ETC).
Du coup je sais pas si je peux continuer à utiliser le principe de Mapomme ou si je dois tout modifier.
grrrr !!!!
A +
Jo
 

Pièces jointes

  • ESSAI SERIE DE 8BASE.xlsx
    113.9 KB · Affichages: 37

laurent950

XLDnaute Accro
Bonsoir,
ce serait quelques choses comme l'extraction automatisé que j'ai faite selon votre explication ?
fichier excel joint
il y a des séries supérieur à 8 heures comme celle du 13 septembre
de 13h00 à 23h00 soit 11h00
selon votre modéle 8h00 soit de 13h00 à 20h00
aussi j'ai considéré dans le modéle pour
MOY TAUX >100 c'est supérieur à 100 donc mis Oui
MOY TAUX > 120 c'est aussi supérieur a 120 j'ai mis oui
donc si oui pour les deux c'est qu'il y a au moins 1 entre 100 et 119.99 et 1 strictement supérieur à 120
cdt
VB:
Sub test()
Dim TBase() As Variant
    TBase = Range(Cells(4, 9), Cells(5, 8770))
Dim Tres As Variant
    ReDim Tres(LBound(TBase, 1) To UBound(TBase, 1), LBound(TBase, 2) To UBound(TBase, 2))
Dim CopiExcel() As Variant
    ReDim CopiExcel(1 To 1, 1 To 7)
Dim cpt As Long: cpt = 0
Dim NumExtract As Long: NumExtract = 1

' nettoyage de la zone
' --------------------
    Range(Cells(10, 2), Cells(1048576, 8)).ClearContents

' Enregistre les séries de 8H supérieur a 100
' -------------------------------------------

For i = LBound(TBase, 2) + 1 To UBound(TBase, 2)
'If i = 3326 Or cpt > 8 Then
'Cells(5, i + 8).Select
'End If
    For j = i To i + 8
        If TBase(2, j) > 100 Then
            Tres(1, j) = TBase(1, j)
            Tres(2, j) = TBase(2, j)
                cpt = cpt + 1
                    If cpt = 8 And (j - i + 1) = 8 Then
                            CopiExcel(1, 1) = NumExtract
                            CopiExcel(1, 2) = Format(Split(Tres(1, j - 7), " ")(0), "dd mmm") ' Date (Début)
                            CopiExcel(1, 3) = Format(Split(Tres(1, j - 7), " ")(1), "h\Hmm") ' heure (Début)
                            CopiExcel(1, 4) = Format(Split(Tres(1, j), " ")(0), "dd mmm")  ' Date (Fin)
                            CopiExcel(1, 5) = Format(Split(Tres(1, j), " ")(1), "h\Hmm")  ' heure (Fin)
                                For k = i To i + 8
                                    If TBase(2, k) >= 100 And TBase(2, k) < 120 Then
                                        CopiExcel(1, 6) = "Oui"
                                    ElseIf TBase(2, k) > 120 Then
                                        CopiExcel(1, 7) = "Oui"
                                    End If
                                Next k
                        cpt = 0
                        i = j
                        NumExtract = NumExtract + 1
                        'Cells(Cells(65536, 2).End(xlUp).Row + 1, 2).Select
                        Cells(Cells(65536, 2).End(xlUp).Row + 1, 2).Resize(LBound(CopiExcel, 1), UBound(CopiExcel, 2)) = CopiExcel
                        Exit For
                    ElseIf cpt <> 8 And (j - i + 1) = 8 Then
                        For k = i To i + 8
                            Tres(1, k) = ""
                            Tres(2, k) = ""
                        Next k
                        cpt = 0
                        Exit For
                    End If
        Else
            cpt = 0
            Exit For
        End If
    Next j
Next i
End Sub
 

Pièces jointes

  • ESSAI SERIE DE 8BASE.xlsm
    165.4 KB · Affichages: 28
Dernière édition:

jojo4738

XLDnaute Nouveau
bonsoir Laurent,
je comprends pas tout dans votre macro, le VBA n'est pas mon fort!!
Mais je constate -voir feuille jointe- ou j'ai extrait manuellement la 1° série de 8 dont la moyenne des taux >100 est trouvée du 2/4 à 23H --> 3/04 à 6h.Pour infos je l'ai fait manuellement pour les 7 premières séries de moyenne >100.
et pour les 2 premières série de moyenne > 120
L'ensemble ne correspond pas à votre extraction. C'est pourquoi il est peut-être plus facile de sortir :
- d'abord les moyennes >100
- puis après les moyennes > 120
en "variabilisant" le taux avant de lancer la macro.
Qu'en pensez-vous
A +
 

Pièces jointes

  • ESSAI SERIE DE 8BASE 1.2.xlsm
    130.1 KB · Affichages: 10

jojo4738

XLDnaute Nouveau
le principe est d'extraire tous les dépassements d'une période 8 heures consécutives et dont la moyenne du taux relevé est > à un taux déterminé variable suivant la norme appliquée (OMS ou CE). Donc en partant du 1 janvier 0 heure on calcul la moyenne des 7 taux relevés suivant ( jusqu'à 7H): si cette moyenne est < inferieur au taux déterminé variable (par exemple 100 norme OMS) on passe au calcul moyen de la tranche 1/8H du 1° janvier et ainsi de suite jusqu'a ce que le taux moyen soit > au taux déterminé variable (par exemple 100 norme OMS): alors on extrait la date ET la moyenne , on zappe les 7 relevé suivants et à partir du 8° on recommence !
J'espère avoir été clair !!!
Cdt
 

laurent950

XLDnaute Accro
si cette moyenne est < inferieur au taux déterminé variable (par exemple 100 norme OMS)
Un exemple pour 8 valeurs
Cas N°1
103+75+88+123+114+75+101+105 = 98 pour la moyenne de ces 8 valeurs
Donc non la moyenne de ces 8 valeurs est inférieur à 100
Cas N°2
103+105+88+123+114+75+108+113 = 103,625 pour la moyenne de ces 8 valeurs
Donc oui la valeurs est supérieur à 100

En fonction de votre réponse et un exemple de votre par si cela correspond pas ou qu il y a une autres règle en complément

Cdt
 

jojo4738

XLDnaute Nouveau
oui c'est ça!
par exemple
données du 1/1/2018 donnees de 0->7H
57,2 /54,4/ 41,9/ 62,4/ 68,8 /54,3/ 59,7/ 47,9 moyenne 55.825 donc < 100 (si on a paramétré ce taux) on passe à la cellule taux suivante
par contre données du 2/04/2018 à 21->3/04/18 3H
94 / 95/ 99,7 / 101,3 / 104,3/104,7/ 103,9 / 101,1 moyenne de 100.5 donc >100(si on a paramétré ce taux) donc on note la date et l'heure dans le tableau et on passe à 8 cellules plus loin
cdt
 

laurent950

XLDnaute Accro
Bonsoir,
J'ai mis des annotations.
J'ai essayer autrement, il y a un réglage à effectué en fonction de l’extraction. je pense que la base est correct en fonction de vos commentaire (J'ai fais toutes les combinaisons pour être sur qu'il n'y ai pas d'oublie, et ensuite j'irais 8 cellules plus loin) une fois vos annotations selon mon modèle dans le fichier excel ci-joint pour finalisé votre projet.

Cdt
 

Pièces jointes

  • ESSAI SERIE DE 8BASE 1.2.xlsm
    161 KB · Affichages: 5

laurent950

XLDnaute Accro
Prise en compte de cette règle avec le décalage :
- tableau et on passe à 8 cellules plus loin (Comme indiqué poste #7)
toujours de annotation (Voir Poste #8 solution sans décalage et le Poste #7 avec le décalage de 8 si > 100 uniquement)
si supérieur à 120 aucun décalage ni action juste une indication pour indiqué que la moyenne est inférieur a 120 ou supérieur à 120 pour les deux poste cité ci dessus

par contre données du 2/04/2018 à 21->3/04/18 3H
94 / 95/ 99,7 / 101,3 / 104,3/104,7/ 103,9 / 101,1 moyenne de 100.5 donc >100
les valeurs ne correspondent pas
93,6 / 94/ 95 / 99,7 /101,3 / 104,3/104,7 moyenne de 98.94 (cela ne fait que 7 valeurs soit 7 heures ?)

A voir en fonction de se que vous allez valider car c'est pas très clair.

cdt
 

Pièces jointes

  • ESSAI SERIE DE 8BASE 1.2 bis.xlsm
    135.7 KB · Affichages: 3
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 729
Messages
2 081 971
Membres
101 852
dernier inscrit
dthi16088