Obtenir des hauteurs a partir d'une base de donnees de courbes [Résolu]

[leny34090]

Bonjour,

travaillant actuellement sur un sujet de recherche agro-alimentaire,

j'obtiens pour chaque secondes de releves 16 temperatures et 1 Pic Number.

Chacune des 16 temperatures a une hauteur definie de 0 a 785 cm.

Je modelise chaque seconde par une courbe avec la hauteur du thermocouple qui mesure la temperature en Ordonnee (de 0 a 785cm).

Donc pour chaque feuille excel j'ai de 1 a n secondes de releves et donc le meme nombre de courbes associes sur un meme graphe.
Mais c'est pas important pour moi d'avoir ce graphe.

Le plus important c'est pour la suite. Chaque courbe doit me donner une hauteur: la thermocline.
Elle se calcule graphiquement (pour le moment, et c'est tres long quand on a 1800 sec a faire) :
on prends la temperature maxi a la seconde voulue et on lui soustrait 2 degres, on fait de meme avec la temperature mini.
On trace deux droites verticales passant par ces deux nouvelles temperatures.
Et on trace deux droites horizontales passant par l'intersection des droites verticales et de la courbe de temperature.
On obtient donc sur l'axe des ordonnes une difference de hauteur, qui nous donne la hauteur de la thermocline recherchee.

Je n'ai aucune idee de comment proceder car je ne maitrise pas du tout Excel, est-il possible d'avoir pour chaque seconde ecoulee, la hauteur de thermocline correspondante.
Ensuite ce qui m'interresse c'est de voir apparaitre le Resultat sous forme d'un tableau a 2 colonnes et n lignes.
1ere colonne: le temps
2eme colonne: le rapport Hauteur thermocline (m) / 0.785 (m)


PS: la feuille excel donnee, jai tracee les courbes que tout les 1L de consommation d'eau, car graphiquement c'est suffisement explicite pour voir l'evolution mais en terme de hauteur de thermocline recherchee, il faudrait savoir les hauteurs pour toute la consommation d'eau.

Je remercie les plus courageux qui m'auront lu jusqu'au bout.
C'est un peu pesant comme description mais je ne saurais pas l'expliquer differement.
ENfin tout de meme si vous avez des questions, je tacherai d'y repondre.
Merci d'avance

[leny34090]

on prends la temperature maxi a la seconde voulue et on lui soustrait 2 degres, on fait de meme avec la temperature mini

je voulais dire +2 degres pour la temperature mini
et -2 degres pour la temperature maxi

Cordialement.

[Benoit Schwob]

Salut Leny,

Si je comprends bien, tu essaies de résoudre ton problème par une démarche graphique dans Excel, non ? De ce que je comprends du sujet, peut-être qu'il vaudrait mieux creuser une piste analytique.

Certes tes courbes sont délicates à mettre en équation, mais sur un petit intervalle, est-ce que c'est faux de les assimiler à des droites ? Et de chercher ensuite tes intersections par interpolation ?

Au fond, les ressources graphiques d'Excel ne sont "jamais que" de la représentation de données : c'est à partir des données qu'on fait les graphiques, et pas à partir des graphiques qu'on établit les données. (Ou si peu, par des manips un peu "à l'arrache"...)

Cela étant, je ne comprends pas le graphique de la feuille "pic" : il semble y avoir plein de courbes, mais tu as supprimé les données de la feuille précédente...

???

Benoît

[leny34090]

Bonjour,

a l'heure actuelle, comme tu dis, je le fais "a l'arache" en tracant des courbes verticales et horizontales.
Mais le meilleur des cas serait d'utiliser ma base de donnees de temperature pour le faire par resolution analytique.
Pour info, mon fichier est trop volumineux pour l'envoyer en integralite, c'est pour cela que j'ai supprimer une bonne partie de la base de donnees.
Souhaites-tu que je te l'envoies sur une boite mail ?

Merci.

[Benoit Schwob]

Bonjour Leny,

Oui, la résolution analytique, c'était l'idée de ma suggestion de résolution par interpolation par exemple...

OK envoie-moi un fichier plus complet, je te passe mon mail en MP.
J'y répondrai ensuite par ici, hein...

A plus,

Benoît

[leny34090]

Ok Benoit, mail envoyer,

le fichier est-il au bon format pour la resolution ?

[Benoit Schwob]

Bonjour Leny,

Ca a l'air d'un joli sujet, tout ça…

Pour que je puisse continuer à réfléchir, dis-moi si j'ai à peu près compris : tu as une colonne de 785 mm avec 16 capteurs fixes échelonnés sur la hauteur (simplement 1 tous les 50 mm ?), et ces capteurs t'envoient chacun une mesure par seconde – pendant 1800 secondes.

Tu cherches à en savoir plus sur les mouvements de la thermocline pendant ces 1800 secondes, c'est ça ?

Surtout dis-moi si je fais fausse route, hein...

Cela étant, je n'arrive pas bien à visualiser le graphique que tu essaies de faire.
Perso, je partirais pour un graphe dont l'axe des abscisses représente le temps (les 1800 secondes) et l'axe des ordonnées la température ; la dessus, je mettrais 16 courbes, c'est-à-dire une par capteur.
(Ou alors c'est ce que tu disais mais j'ai pas compris ? Ou alors mon idée est jolie mais strictement inutile ?)

Dernière chose : le Pic Number, c'est quoi ???

A plus,

Benoît

[leny34090]

Benoit,

tu as presque tout compris oui.

C'est donc bien ca, une cuve de hauteur 785 mm avec des capteurs echelones sur la hauteur.
Chacun va me donner a une hauteur donee une temperature.

On veut donc savoir comment la thermocline (couche intermediaire) se comporte suivant la hauteur ou elle se trouve.

Le PIC number est un indicateur. Si il vaut 1, c'est le cas ideal avec une thermocline inexistante, donc un fluide chaud et un froid bien distinct.
S'il vaut 0, c'est une parfaite mixite, la thermocline est presente sur toute la hauteur de la cuve.

C'est pourquoi je veux avoir en courbe la valeur de la thermocline apres un certain temps donnee ( qui correspond a une consommation d'eau en Litre sur ma courbe). J'ai donc une courbe apres 1L (100,300 secondes suivant le debit utiliser), une autre apres 5L, une autre apres 20 L..etc
J'ai donc 16 points par courbes correspondant a mes 16 thermocouples.

Sur les courbes que je t'ai donnee, je n'ai choisit de representer qu'a certains temps donnes, car representer les 1800 secondes serait de trop.

En ordonnes nous avons la hauteur et nous pouvons donc interpreter que la zone ou c'est "plat", pas vraiment croissant... c'est la zone de la thermocline.

c'est un peu plus clair maintenant?
N'hesite pas a me demander d'autres explications si cela ne suffit pas.
A bientot.

[mercatog]

Bonsoir
J’interfère dans le sujet, j'ai préparé un fichier avec macro qui permet pour chaque t de trouver la différence de hauteurs entre les 2 températures (maximum -2 et minimum +2)
le but et pour chaque t, chercher les 2 couples de capteurs qui entourent ces 2 températures

Code (avec commentaire sommaire)

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
Private Sub CommandButton2_Click()
Dim Shd As Worksheet, Sht As Worksheet
Dim X As Range, c As Range
Dim Mx As Double, Mn As Double, H1 As Double, H2 As Double
Dim LastLig As Long, i As Long
Dim LastCol As Integer
 
Application.ScreenUpdating = False
'-----------------------------------------------------Préparation Feuille résultat analyse--------
On Error Resume Next
Set Sht = Worksheets("Temp")
On Error GoTo 0
If Sht Is Nothing Then
    Set Sht = Sheets.Add(After:=Worksheets("Data"))
    Sht.Name = "Temp"
Else
    Sht.UsedRange.Clear
End If
With Sht.Range("A1:F1")
    .Value = Array("t", "Max - 2°", "Min + 2°", "Hhaut", "Hbas", "Delta h")
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
End With
'--------------------------------------------------------------------------------------------------
Set Shd = Worksheets("Data")
With Shd
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row                   'Dernière ligne remplie de la colonne A
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column         'Dernière colonne remplie de la ligne 1
    For i = 3 To LastLig                                             'On parcours les plages lignes par ligne
        Set X = .Range(.Cells(i, 2), .Cells(i, LastCol))
        Mx = Application.Max(X) - 2                                  'Mx: maximum de la ligne +2
        Mn = Application.Min(X) + 2                                  'Mn: Minimum de la ligne +2
        Set c = Recherche(X, Mx)                                     'On récupère dans c la cellule juste supérieur à Mx (valeur w), la cellule juste inférieur à Mx (valeur z)
        H1 = Reg(c, Mx)                                              'On fait une regression linéaire entre w et z
        Set c = Recherche(X, Mn)                                     'De même pour Mn
        H2 = Reg(c, Mn)
        Set X = Nothing
        Set c = Nothing
        Sht.Range("A" & i - 1).Value = .Range("A" & i).Value         'On écrit le résultat dans feuille Temp
        Sht.Range("B" & i - 1).Value = Mx
        Sht.Range("C" & i - 1).Value = Mn
        Sht.Range("D" & i - 1).Value = H1
        Sht.Range("E" & i - 1).Value = H2
        Sht.Range("F" & i - 1).Value = H1 - H2
    Next i
End With
End Sub
 
'Fonction de recherche de la cellule dont la valeur est juste supérieur à la veleur de recherche T
Private Function Recherche(Rng As Range, ByVal T As Double) As Range
Dim c As Range
 
For Each c In Rng
    If c.Value <= T Then Exit For
Next c
Set Recherche = c.Offset(0, -1)
End Function
 
'Fonction de regression linéaire entre 2 points (éqution d'une droite)
Private Function Reg(Rng1 As Range, ByVal T As Double) As Double
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
Dim Rng2 As Range
 
Set Rng2 = Rng1.Offset(0, 1)
x1 = Rng1.Value
x2 = Rng2.Value
y1 = Rng1.Offset(1 - Rng1.Row, 0).Value
y2 = Rng2.Offset(1 - Rng2.Row, 0).Value
Set Rng2 = Nothing
Reg = ((y2 - y1) / (x2 - x1)) * (T - x1) + y1
End Function

[leny34090]

Bonsoir,

je viens juste d'essayer ton programme, ca marche tres bien... jusqu'a 690 secondes.
jai un Run-time error '13': type mismatch qui fait que lorsque je rentre une base de donnee de 1800 secondes, il me calcule les hauteurs de thermocline uniquement jusqu'a 690 secondes.

Une solution a ce probleme ?
sinon merci vraiment beaucoup.
Je sais que Benoit avait commencer a travailler dessus, merci aussi a toi Benoit.
Je suis quand meme preneur de ce que tu as fait, afin de comparer.

ca me surligne en jaune cette ligne quand j'utilise debug

Code :

y1 = Rng1.Offset(1 - Rng1.Row, 0).Value

[mercatog]

ca marche tres bien... jusqu'a 690 secondes.

Quelle particularité des données là où le code s'arrête.
Je pense qu'on est dans un cas où x1-x2 est assez petit.
Essaies tout d'abord en modifiant cette fonction ainsi:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Function Reg(Rng1 As Range, ByVal T As Double) As Double
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
Dim Rng2 As Range
 
Set Rng2 = Rng1.Offset(0, 1)
x1 = Rng1.Value
x2 = Rng2.Value
y1 = Rng1.Offset(1 - Rng1.Row, 0).Value
y2 = Rng2.Offset(1 - Rng2.Row, 0).Value
Set Rng2 = Nothing
If Abs(x1 - x2) < 0.0001 Then
    Reg = y1
Else
    Reg = ((y2 - y1) / (x2 - x1)) * (T - x1) + y1
End If
End Function

Edit: Une question importante: tes données ligne par ligne sont t elles triées par ordre décroissant?
Sinon, tu peux joindre tes feuilles de données comportant les 1800s...

Edit2:J'ai revu ton fichier de l'autre sujet. Effectivement les données ne sont pas triées avec un pic (Respectivement un creux) dans la colonne à 104°C, et de ce fait, l'interpolation est erronée.
Ce pic (resp. creux) engendre l'existence de 2 points à Tmax-2° (resp. Tmin+2°)
cf courbes.
Je suppose que les mesures de cette colonnes sont aléatoires. mais bon, j'attends infirmation ou confirmation (ou étalonnage)

[leny34090]

oui, mes lignes vont de 1 a 1800 secondes par ordre croissant.
suivant mes feuilles, des fois il calcule jusqu'a 18 secondes ou 300 ou 1450... c'est a rien y comprendre...

[mercatog]

Je propose de regarder de plus près la colonne 104°C

[leny34090]

dans quel format envoyer sur ce forum...
en .xls je depasse la taille autorisee, en .txt aussi

[mercatog]

Tu peux supprimer tes anciennes pièces jointes, crée un nouveau fichier avec une seule feuille contenant les données brutes (sans code ni formule) et éventuellement en zip.
Sinon utilise par exemple ce site ou autre pour l'envoi du ficher et communique l'url correspondante.

[leny34090]

Tu trouveras ci-joint la base de donnees.
Merci d'avance.

[mercatog]

Remplace le code précédent par celui ci

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
Private Sub CommandButton2_Click()
Dim Shd As Worksheet, Sht As Worksheet
Dim X As Range, c As Range
Dim Mx As Double, Mn As Double, H1 As Double, H2 As Double
Dim LastLig As Long, i As Long
Dim LastCol As Integer
 
Application.ScreenUpdating = False
'-----------------------------------------------------Préparation Feuille résultat analyse--------
On Error Resume Next
Set Sht = Worksheets("Temp")
On Error GoTo 0
If Sht Is Nothing Then
    Set Sht = Sheets.Add(After:=Worksheets("Data"))
    Sht.Name = "Temp"
Else
    Sht.UsedRange.Clear
End If
With Sht.Range("A1:F1")
    .Value = Array("t", "Max - 2°", "Min + 2°", "Hhaut", "Hbas", "Delta h")
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
End With
'--------------------------------------------------------------------------------------------------
Set Shd = Worksheets("Data")
With Shd
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row                   'Dernière ligne remplie de la colonne A
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column         'Dernière colonne remplie de la ligne 1
    For i = 3 To LastLig                                             'On parcours les plages lignes par ligne
        Set X = .Range(.Cells(i, 2), .Cells(i, LastCol))
        Mx = Application.Max(X) - 2                                  'Mx: maximum de la ligne +2
        Mn = Application.Min(X) + 2                                  'Mn: Minimum de la ligne +2
        Set c = Recherche(X, Mx)                                     'On récupère dans c la cellule juste supérieur à Mx (valeur w), la cellule juste inférieur à Mx (valeur z)
        H1 = Reg(c, Mx)                                              'On fait une regression linéaire entre w et z
        Set c = Recherche(X, Mn)                                     'De même pour Mn
        H2 = Reg(c, Mn)
        Set X = Nothing
        Set c = Nothing
        Sht.Range("A" & i - 1).Value = .Range("A" & i).Value         'On écrit le résultat dans feuille Temp
        Sht.Range("B" & i - 1).Value = Mx
        Sht.Range("C" & i - 1).Value = Mn
        Sht.Range("D" & i - 1).Value = H1
        Sht.Range("E" & i - 1).Value = H2
        Sht.Range("F" & i - 1).Value = H1 - H2
    Next i
End With
End Sub
 
'Fonction de recherche de la cellule dont la valeur est juste supérieur à la valeur de recherche T
Private Function Recherche(Rng As Range, ByVal T As Double) As Range
Dim c As Range
Dim i As Integer
 
For Each c In Rng
    i = i + 1
    If c.Value <= T Then Exit For
Next c
If i > 1 Then
    Set Recherche = c.Offset(0, -1)
Else
    Set Recherche = c
End If
End Function
 
'Fonction de regression linéaire entre 2 points (éqution d'une droite)
Private Function Reg(Rng1 As Range, ByVal T As Double) As Double
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
Dim Rng2 As Range
 
Set Rng2 = Rng1.Offset(0, 1)
x1 = Rng1.Value
x2 = Rng2.Value
y1 = Rng1.Offset(1 - Rng1.Row, 0).Value
y2 = Rng2.Offset(1 - Rng2.Row, 0).Value
Set Rng2 = Nothing
If Abs(x1 - x2) < 0.0001 Then
    Reg = y1
Else
    Reg = ((y2 - y1) / (x2 - x1)) * (T - x1) + y1
End If
End Function

et fais le test.
J'attends ton feed back sur les résultats obtenus (globalement satisfaisants avec quelques singularités a étudier plus tard).

[leny34090]

oh Waaaahouu!

BRILLIANT !!! :-)

Tu m'enleves une sacree epine du pied !!!

En effet, maintenant tout marche pour le mieux...
aucun message d'erreur...

juste j'appuie sur analyser, je sens que l'excitation monte et apres 3 secondes...des milliers de petites thermocline qui apparaissent !!!
super !!!

merci beaucoup pour ta reactivite et ta disponibilite !
Leny.

[mercatog]

Il reste des question de fond
Car le résultat n'est guère satisfaisant dans sa globalité.
le code est optimal si et seulement si les données ligne par ligne sont triées par ordre décroissant, ce qui n'est pas la cas dans tes séries de données.

Pour minimiser les erreurs dues aux singularités, sur un autre fichier et avec les même données, teste ce code et compare les résultats (à l'aide de graphiques) avec le précédent code:

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
Private Sub CommandButton2_Click()
Dim Shd As Worksheet, Sht As Worksheet
Dim X As Range, c As Range
Dim Mx As Double, Mn As Double, H1 As Double, H2 As Double
Dim LastLig As Long, i As Long
Dim LastCol As Integer
 
Application.ScreenUpdating = False
'-----------------------------------------------------Préparation Feuille résultat analyse--------
On Error Resume Next
Set Sht = Worksheets("Temp")
On Error GoTo 0
If Sht Is Nothing Then
    Set Sht = Sheets.Add(After:=Worksheets("Data"))
    Sht.Name = "Temp"
Else
    Sht.UsedRange.Clear
End If
With Sht.Range("A1:G1")
    .Value = Array("t", "Max - 2°", "Min + 2°", "Hhaut", "Hbas", "Delta h", "Rapp h")
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
End With
'--------------------------------------------------------------------------------------------------
Set Shd = Worksheets("Data")
With Shd
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row                   'Dernière ligne remplie de la colonne A
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column         'Dernière colonne remplie de la ligne 1
    For i = 3 To LastLig                                             'On parcours les plages lignes par ligne
        Set X = .Range(.Cells(i, 2), .Cells(i, LastCol))
        Mx = Application.Max(X) - 2                                  'Mx: maximum de la ligne +2
        Mn = Application.Min(X) + 2                                  'Mn: Minimum de la ligne +2
        Set c = Recherche(X, Mx)                                     'On récupère dans c la cellule juste supérieur à Mx (valeur w), la cellule juste inférieur à Mx (valeur z)
        H1 = Reg(c, Mx)                                              'On fait une regression linéaire entre w et z
        Set c = Recherche(X, Mn)                                     'De même pour Mn
        H2 = Reg(c, Mn)
        Set X = Nothing
        Set c = Nothing
        Sht.Range("A" & i - 1).Value = .Range("A" & i).Value         'On écrit le résultat dans feuille Temp
        Sht.Range("B" & i - 1).Value = Mx
        Sht.Range("C" & i - 1).Value = Mn
        Sht.Range("D" & i - 1).Value = H1
        Sht.Range("E" & i - 1).Value = H2
        Sht.Range("F" & i - 1).Value = H1 - H2
        Sht.Range("G" & i - 1).Value = (H1 - H2) / 0.785
    Next i
End With
End Sub
 
'Fonction de recherche de la cellule dont la valeur est juste supérieur à la valeur de recherche T
Private Function Recherche(Rng As Range, ByVal T As Double) As Range
Dim c As Range
Dim i As Integer
 
For Each c In Rng
    i = i + 1
    If c.Value <= T And i > 1 Then Exit For
Next c
Set Recherche = c.Offset(0, -1)
End Function
 
'Fonction de regression linéaire entre 2 points (éqution d'une droite)
Private Function Reg(Rng1 As Range, ByVal T As Double) As Double
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
Dim Rng2 As Range
 
Set Rng2 = Rng1.Offset(0, 1)
x1 = Rng1.Value
x2 = Rng2.Value
y1 = Rng1.Offset(1 - Rng1.Row, 0).Value
y2 = Rng2.Offset(1 - Rng2.Row, 0).Value
Set Rng2 = Nothing
If Abs(x1 - x2) < 0.0001 Then
    Reg = y1
Else
    Reg = ((y2 - y1) / (x2 - x1)) * (T - x1) + y1
End If
End Function

Je confirme qu'il faut prendre le 2ème code qui donne des résultats plus homogènes.

[leny34090]

Alors graphiquement, avec ma regle.
Lorsque je mesure les hauteurs je suis entre les valeurs de Delta h et Rapp h mais toujours plus pret de Delta h que de Rapp h.