[XL-2010] Extraction de valeurs automatique et selon critère d'un tableau (220000 lignes) [Résolu]

[GuiBar18]

Bonjour à vous tous.

Je cherche à me faire un petit bout de code pour me simplifier la vie mais je bloque sur certains points.
Voici le concept.

Je récupère un fichier d'enregistrement de pluviométrie au pas de temps minute sur X mois (soit 220505 lignes sur 5 mois). Le fichier est organisé en selon trois colonnes principale : "DATE/Pluie (mm)/Intensité(mm/h)" La date comprend aussi l'heure t la minute. J'ai donc, sur X mois, autant de lignes qu'il y a de minutes.
Bien sur, comme il ne pleut pas en continu, beaucoup de ces lignes contiennent des 0. Je souhaite donc "extraire" les épisodes pluvieux.
Pour poser le vocabulaire, un épisode est une suite d'évènements au pas de temps minutes. Un épisode d'1 heure contient donc 60 évènements.

En sachant que :

• Deux évènements espacés de moins de la durée T, exprimée en minutes (et donc en nombre de lignes, puisque une ligne par minute), sont considérés comme apparentant au même épisode, il faut donc copier les 0 entre les deux évènements.
• Un épisode (une suite d'évènements) est considéré comme non significatifs s'il est inférieur à une quantité de pluie S et n'est donc pas recopié

Ainsi, par exemple, une pluie isolée (distante de plus de T de l'évènement suivant et précédent) de 1 minutes est à la fois un épisode et un évènement. S'il est supérieur à S il doit être "extrait", sinon non.
Autre exemple, un évènement nul (0) est inférieur à S mais s'il est proche d'un autre évènements (distant de moins de T avant ou après) supérieur à S il doit être "extrait" car il permet de reconstituer l'épisode au complet

par "extrait", j’entends une copie de la valeur des trois colonne sur une nouvelle feuille. Ainsi, de mon tableau de base, je récupère un tableau ne comprenant que les épisodes pluvieux, sans 0 "inutiles" (non inclus dans un épisodes) et je passe de 220505 lignes à environ 30 000 sur 5 mois (voire moins en fonction de la pluie mesurée et des mois considérés)

Pour l'instant, j'ai essayé, avec mes maigres connaissance, de faire ceci :

Code :

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
Dim Analyse As Worksheet
Dim Origine As Worksheet
Dim Dest As Worksheet
Dim LgOri As Integer
Dim LgDest As Integer
Dim NbLgOri As Long
Dim Seuil As Single
Dim Tmin As Single
Dim Tjour As Single
Dim SommeAvt As Single
Dim SommeApr As Single
 
'Préparation du calcul
Set Origine = Worksheets("SOURCE")
Set Dest = Worksheets("Extraction")
Set Analyse = Worksheets("ANALYSE")
 
'Initialisation du calcul
Seuil = Analyse.Cells(1, 2).Value
Tmin = Analyse.Cells(2, 2).Value
Tjour = Analyse.Cells(3, 2).Value
NbLgOri = Analyse.Cells(4, 2).Value
 
'Prise en compte des en-têtes de colonne
LgDest = 2
LgOri = 2
 
'Extraction des évènements
Do While LgOri < NbLgOri
    'Calcul du critère de vérification de l'isolement de l'épisode
    If LgOri < Tmin Then
        SommeC = 2
    Else
        SommeC = LgOri - Tmin
 
    SommeAvt = WorksheetFunction.Sum(Origine.Range("D" & SommeC & ":" & "D" & LgOri))
    SommeApr = WorksheetFunction.Sum(Origine.Range("D" & LgOri & ":" & "D" & (LgOri + Tmin)))
 
    End If
 
    'Extraction de l'épisode en fonction de la quantité de pluie en mm et de SommeC
    If Origine.Cells(LgOri, 4).Value > S Then
        Dest.Cells(LgDet, 1).Value = Origine.Cells(LgOri, 1).Value
        Dest.Cells(LgDet, 2).Value = Origine.Cells(LgOri, 4).Value
        Dest.Cells(LgDet, 3).Value = Origine.Cells(LgOri, 5).Value
 
    ElseIf Origine.Cells(LgOri, 4).Value > S And SommeC <> 0 Then
        Dest.Cells(LgDet, 1).Value = Origine.Cells(LgOri, 1).Value
        Dest.Cells(LgDet, 2).Value = Origine.Cells(LgOri, 4).Value
        Dest.Cells(LgDet, 3).Value = Origine.Cells(LgOri, 5).Value
    End If
'Placement sur la destination
LgDest = LgDest + 1
 
Loop
 
End Sub

J'ai mis le tout sur un bouton.
Évidemment, cela ne marche pas, mais je ne sais pas pourquoi. a noter que mes compétences étant plus que limitées, le code donné ne répond aps tout à fait à mes propres exigences : il ne vérifie pas si le total d'un épisode fait plus que le seuil S.

Si quelqu'un de charitable a une idée pour me débloquer ou voit pourquoi cela ne marche pas, je suis preneur.

Merci d'avance.


EDIT : le code contenait deux erreur : il partait de 0 pour le Loop, ce qui n'est pas possible. Maintenant il pars de 2 (en-têtes de colonnes).
J'ai rajouté une variable faisant référence à ma feuille de donnée (qui contient les valeurs de T et S)
Le programme s'arrête à la ligne 32767 pour dépassement de capacité.

[tedo01]

Bonjour,
Sans aller décortiquer le code, j'ai une première remarque sur la base de l'aide Excel :

Les variables de type Integer sont stockées sous la forme de nombres
de 16 bits (2 octets) dont la valeur est comprise entre -32 768 et 32 767

Pour mémoriser une ligne dans Excel, il faut donc utiliser une variable de type Long, pas Integer...

[pijaku]

Bonjour,
Sans décortiquer, non plus, le code :

Bien sur, comme il ne pleut pas en continu, beaucoup de ces lignes contiennent des 0. Je souhaite donc "extraire" les épisodes pluvieux.

Je ferais déjà comme ceci : [Valable pour Excel version < 2007]
1- Clic sur l'entête d'une colonne,
2- Données/Filtres > filtre automatique,
3- Cliquer sur le menu déroulant situé dans la colonne "Pluie" choisir "personnalisé"
4- "Sélectionner les lignes pour lesquelles" Pluie
choisir dans le menu déroulant de gauche "différent de" et à droite inscrire 0
Cliquez sur OK

Un simple copié collé dans une autre feuille (ou un autre classeur pour ne pas alourdir celui-ci) vous permet de n'obtenir que les épisodes pluvieux en 3-4 clics...

[Sclarckone]

Sinon, c'est pas pour faire mon rabat-joie mais Access me semble beaucoup plus indiqué pour ce genre de problème.

[Jean-Pierre49]

Bonjour,

Sans passer par Access, j’enregistrerais, via Vba les données du tableau dans un fichier txt et je requêterais dedans,

Donne un extrait de ton tableau en csv (je n’ai pas 2007 sur mon poste) afin de voir

Bon courage

[GuiBar18]

Merci à tous pour vos commentaires.
Effectivement, Access serait pas mal adapté pour ce genre de problèmes, seulement voila, je dialogue avec des gens qui ont une peur panique des mots Access, Base de donnée ou encore macro.
ils s'imaginent qu'ils vont "perdre le contrôle" ou encore qu'ils ne sauront pas utiliser l'outil.
Enfin bref, ça c'est mon souci au quotidien. Du coup, quand je me développe un petit outil de calcul qui peut aussi servir aux autres, je me limite à VBA et à Excel, comme ça, pas de traumatisé et l'outil est utilisé plutôt que de rester dans un coin parce que les gens en ont peur.

Pour le reste, j'ai pas mal avancé sur mon projet. Au total j'ai fait le choix de faire plusieurs sub indépenadntes :

1. La première extrait les évènements, sans filtration
2. La seconde filtre les évènements
3. La troisième les numérote (en fontion de la durée et de la date de début)
4. La dernière construit des synthèses pour une analyse statistique
5. Une cinquième prépare un fichier texte pour l'importation dans un modèle de calcul

Le tout marche bien et j'ai aussi fait un bouton qui lance les 4 première étapes en une seule fois (pourquoi ne pas m'avoir fait tout de suite ?? Eh bien c'est encore cette histoire de contrôle sur le processus).

La difficulté des codes (qui n'en est pas une avec un peu de rigueur et de logique) réside dans la gestion des boucles imbriquées : une boucle qui compte les lignes de destination et dans cette boucle une autre qui compte pour parcourir le tableau. Une fois ce principe acquis, le reste, c'est juste de la mise en musique.

Pour info, je poste le code de la première et de la troisième sub. Alors bien sur, cela n'a rien du professionnalisme de certains code vu ici mais cela à le mérite de fonctionner, assez rapidement et sans accros.

Code :

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
'Code permettant l'extraction des évènements pluvieux d'une chronique au pas de temps fixe
'Un évènement est un groupe d'enregistrements de pluies, distants de moins de la durée d'analyse T et supérieurs (individuellement) au seuil S
 
'Code créé le 26/09/2011 par GBR
 
Dim analyse As Worksheet
Dim Origine As Worksheet
Dim Dest As Worksheet
Dim LgOri As Long
Dim LgDest As Long
Dim NbLgOri As Long
Dim seuil As Single
Dim Tmin As Single
Dim Tjour As Single
Dim SommeAvt As Single
Dim SommeApr As Single
Dim SommeC As Single
Dim filtre As Worksheet
 
'Préparation du calcul
Set analyse = Worksheets("ANALYSE")
Set Origine = Worksheets("SOURCE")
Set Dest = Worksheets("Extraction")
Set filtre = Worksheets("EXTRACTION FILTREE")
 
'Nettoyage préalable des feuilles de calcul
Dest.Range("A:F").Clear
filtre.Range("A:F").Clear
 
'Initialisation du calcul
Pexclu = analyse.Cells(1, 2).Value
Tmin = analyse.Cells(2, 2).Value
Tjour = analyse.Cells(3, 2).Value
NbLgOri = analyse.Cells(4, 2).Value
seuil = analyse.Cells(5, 2).Value
 
'Prise en compte des en-têtes de colonne
LgDest = 2
LgOri = 2
 
'Préparation de la feuille extraction
Dest.Range("A:C").Clear
Dest.Cells(1, 1) = "Date"
Dest.Cells(1, 2) = "Hauteur précipitée (mm)"
Dest.Cells(1, 3) = "Intensité (mm/h)"
 
'Extraction des évènements
Do While LgOri < NbLgOri
    'Calcul du critère de vérification de l'isolement de l'épisode
    If LgOri < (Tmin + 2) Then
        SommeAvt = WorksheetFunction.Sum(Origine.Range("D2:" & "D" & (LgOri - 1)))
        SommeApr = WorksheetFunction.Sum(Origine.Range("D" & (LgOri + 1) & ":" & "D" & (LgOri + Tmin)))
    Else
        SommeAvt = WorksheetFunction.Sum(Origine.Range("D" & (LgOri - Tmin) & ":" & "D" & (LgOri - 1)))
        SommeApr = WorksheetFunction.Sum(Origine.Range("D" & (LgOri + 1) & ":" & "D" & (LgOri + Tmin)))
    End If
 
    'Etablissement de la somme de controle SommeAvt OU Somme Arr nuls --> L'évènements est considéré comme isolé et n'est pas copié
    'Ici on empêche de copier T valeurs 0 avant et après chaque évènements. Par contre, l'extrémité d'un évènement (première valeur ou dernière valeur) inférieur à S est toujours ignorée
    SommeC = SommeAvt * SommeApr
 
    'Copie si l'évènement est supérieur à Seuil
    If Origine.Cells(LgOri, 5).Value >= seuil Then
        Dest.Cells(LgDest, 1).Value = Origine.Cells(LgOri, 1).Value
        Dest.Cells(LgDest, 2).Value = Origine.Cells(LgOri, 4).Value
        Dest.Cells(LgDest, 3).Value = Origine.Cells(LgOri, 5).Value
        'Passage à la ligne de destination suivante
        LgDest = LgDest + 1
 
    'Copie des 0 entre les évènements si durée entre 2 est inférieure à T
    ElseIf Origine.Cells(LgOri, 5).Value < seuil And SommeC <> 0 Then
        Dest.Cells(LgDest, 1).Value = Origine.Cells(LgOri, 1).Value
        Dest.Cells(LgDest, 2).Value = Origine.Cells(LgOri, 4).Value
        Dest.Cells(LgDest, 3).Value = Origine.Cells(LgOri, 5).Value
        'Passage à la ligne de destination suivante
        LgDest = LgDest + 1
 
'La copie sur le critère SommeC oublie les extrémités des évènements pluvieux si ils sont inférieur à Seuil.
'Pour éviter cet oubli,mise en place d'une copie des évènements si la valeur immédiatement après ou avant est non nulle, indépendamment d'une comparaison à S
'Cette comparaison se fait sur les cellules proches. Le nombre de cellules est réglé sur le temps de recherche des adjacents
'Copie dans les cas immédiatement précédents et suivants
        ElseIf Origine.Cells(LgOri + 1, 5).Value <> 0 Then
           Dest.Cells(LgDest, 1).Value = Origine.Cells(LgOri, 1).Value
            Dest.Cells(LgDest, 2).Value = Origine.Cells(LgOri, 4).Value
            Dest.Cells(LgDest, 3).Value = Origine.Cells(LgOri, 5).Value
            'Passage à la ligne de destination suivante
            LgDest = LgDest + 1
 
        ElseIf Origine.Cells(LgOri - 1, 5).Value <> 0 Then
            Dest.Cells(LgDest, 1).Value = Origine.Cells(LgOri, 1).Value
            Dest.Cells(LgDest, 2).Value = Origine.Cells(LgOri, 4).Value
            Dest.Cells(LgDest, 3).Value = Origine.Cells(LgOri, 5).Value
            'Passage à la ligne de destination suivante
            LgDest = LgDest + 1
 
        End If
'Compteur de boucle
LgOri = LgOri + 1
Loop
 
'Supression de la ligne 2 qui est une ligne parasite
Dest.Cells(2, 1).EntireRow.Delete
 
End Sub

Code :

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
'Code permettant la numérotation et le nommage des évènements pluvieux. Qu'ils soient filtrés ou non
'Un évènement est un groupe d'enregistrements de pluies, distants de moins de la durée d'analyse T et supérieurs (individuellement) au seuil S
'La numérotation se base sur le fait qu'entre deux évènements il y a deux et deux seulement valeurs nulles (résidu de filtration)
 
 
'Code créé le 29/09/2011 par GBR
 
Dim filtre As Worksheet
Dim Dest As Worksheet
Dim LigneDest As Long
Dim ligneFiltre As Long
Dim Num As Integer
Dim DerDest As Long
Dim Derfiltre As Long
Dim début As Date
 
 
'Initialisation des variables
Set Dest = Worksheets("EXTRACTION")
Set filtre = Worksheets("EXTRACTION FILTREE")
 
'Nettoyage préalable des colonnes
Dest.Range("D:E").Clear
filtre.Range("D:E").Clear
 
'Calcul de la dernière ligne des tableaux
DerDest = Dest.Range("A1").End(xlDown).Row
Derfiltre = filtre.Range("A1").End(xlDown).Row
 
'Inscription des En-têtes
Dest.Cells(1, 4) = "Numéro évènement"
Dest.Cells(1, 5) = "Nom de l'évènement"
filtre.Cells(1, 4) = "Numéro évènement"
filtre.Cells(1, 5) = "Nom de l'évènement"
 
'traitement des épisodes filtrés
    'Initialisation des compteurs
    Num = 1
    début = filtre.Cells(2, 1)
 
    'Ecriture du premier évènement
    filtre.Cells(2, 4) = Num
    filtre.Cells(2, 5) = Format(Num, "0000") & " - " & Format(début, "dd / mm")
 
    For ligneFiltre = 2 To Derfiltre
        'Recherche d'appatenance à un épisode
        If filtre.Cells(ligneFiltre, 3) = 0 Then
            If filtre.Cells(ligneFiltre + 1, 3) = 0 And filtre.Cells(ligneFiltre + 2, 3) <> 0 Then
                Num = Num + 1
                début = filtre.Cells(ligneFiltre + 1, 1)
                Else:  'Ne fait rien
            End If
        Else: 'Ne fait rien
        End If
 
        'Attribution du numéro et du nom
        filtre.Cells(ligneFiltre + 1, 4) = Num
        filtre.Cells(ligneFiltre + 1, 5) = Format(Num, "0000") & " - " & Format(début, "dd / mm")
    Next ligneFiltre
 
'supression de la dernière ligne parasite
filtre.Cells(Derfiltre + 1, 4).Clear
filtre.Cells(Derfiltre + 1, 5).Clear
 
 
'traitement des épisodes non filtrés
    'Initialisation des compteurs
    Num = 1
    début = Dest.Cells(2, 1)
 
    'Ecriture du premier évènement
    Dest.Cells(2, 4) = Num
    Dest.Cells(2, 5) = Format(Num, "0000") & " - " & Format(début, "dd / mm")
 
    For LigneDest = 2 To DerDest
        'Recherche d'appatenance à un épisode
        If Dest.Cells(LigneDest, 3) = 0 Then
            If Dest.Cells(LigneDest + 1, 3) = 0 And Dest.Cells(LigneDest + 2, 3) <> 0 Then
                Num = Num + 1
                début = Dest.Cells(LigneDest + 1, 1)
                Else:  'Ne fait rien
            End If
        Else: 'Ne fait rien
        End If
 
        'Attribution du numéro et du nom
        Dest.Cells(LigneDest + 1, 4) = Num
        Dest.Cells(LigneDest + 1, 5) = Format(Num, "0000") & " - " & Format(début, "dd / mm")
    Next LigneDest
 
'supression de la dernière ligne parasite
Dest.Cells(DerDest + 1, 4).Clear
Dest.Cells(DerDest + 1, 5).Clear
 
End Sub