Discussion :

[docjam71]

Bonjour,

J'ai des données assez conséquentes ( ça peut aller jusqu'à' 18000 cellules). Pour résumé, j'ai un signal " sinusoïdale" centré sur 0 (ça ressemble plus à un signal carré ou la partie haute (ou basse si on est en négatif) varie). Le but est de récupérer la moyenne du min et du max pour chaque variation de la partie haute et faire ça pour chaque "sinusoïde". Vous me suivez?

Je me suis arrangé pour supprimer la partie négative. Ceci se retrouve à 0. J'ai pris le cas de celui qui avait le moins de points (6000 cellules quand même) ou j'ai fait une macro. Pour chaque "carré" je calcul le max etc....c'est long...

En sachant que mes données changent à chaque fois car il n'y a pas le même nombres de points.

Quelle est la meilleur solution? en réalité je cherche à lisser mes courbes pour chaque max récupéré.

Merci!

PS : je suis sur Excel 2010

Re,

Pour expliquer un peut mieux ce que je veux faire :

j'ai une courbe à 2 dimensions (X>0) par contre les Y positifs et négatifs.

Est-il possible de créer un programme sur VB pour dire : à partir de telle ligne telle colonne (Y), sélectionner la première série de points positifs et calculer le max, puis la 2ième série de points positifs et calculer le max....ainsi de suite jusqu'à la dernière série positive.

Merci!

[mercatog]

Bonjour

Une proposition (gymnastique)

Ton fichier: Données en Feuil1: X en A2:Axx et Y en B2:Bxx.
On récupère Y* en C2:Cxx (résultats après modification des valeurs positives de Y).

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
Private Sub Lissage()
Dim LastLig As Long, i As Long, j As Long, k As Long
Dim First As Boolean
Dim S As Double
Dim Tb, Res()
 
Application.ScreenUpdating = False
With Sheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Tb = .Range("B2:B" & LastLig)
    Do While i < LastLig - 1
        i = i + 1
        If Tb(i, 1) > 0 Then
            If Not First Then
                k = 1
                First = True
                j = j + 1
                ReDim Preserve Res(1 To 2, 1 To j)
                Res(1, j) = i
            Else
                k = k + 1
            End If
        Else
            First = False
        End If
        If First Then Res(2, j) = k
    Loop
    For j = 1 To UBound(Res, 2)
        S = Fmax(Res(1, j), Res(2, j), Tb)
        For i = Res(1, j) To Res(1, j) + Res(2, j) - 1
            Tb(i, 1) = S
        Next i
    Next j
    .Range("C1") = "Y*"
    .Range("C2:C" & LastLig) = Tb
End With
End Sub
 
'Cherche le max d'une partie commençant en m et de taille n de MonTab
Private Function Fmax(ByVal m As Long, ByVal h As Long, ByRef MonTab As Variant) As Double
Dim i As Integer
Dim S As Double
 
S = MonTab(m, 1)
If h > 1 Then
    For i = m + 1 To m + h - 1
        If MonTab(i, 1) > S Then S = MonTab(i, 1)
    Next i
End If
Fmax = S
End Function

[docjam71]

Merci mercatog! Pas mal du tout

Par contre es-ce que tu pourrais m'expliquer ligne par ligne ce que tu fais?

Avec ton code, pour une série positive, il repère le max et le met sur tous les valeurs de la série. Je voudrais simplement récupérer une valeur du max pour chaque série positive pour me faciliter la tâche après pour le tracé de la courbe.

Thanks!

[mercatog]

Le code parcours ligne par ligne la colonne B.
à la première valeur positive elle met la ligne correspondante dans le tableau Res(1,xx). ensuite il continu son parcours jusqu’à' à la valeur suivante négative. Le nombre de lignes trouvées est mis dans Res(2,xx).
Et recommence son chemin jusqu'à la dernière cellule remplie.

A la fin on se retrouve avec un tableau Res comprenant les débuts des séries positives et la "portée" de chacune.

Exemple avec cette série de donnée commençant en B2:
B2: -13
B3: 24
B4: 13
B5: 15
B6: -6
B7: -7
B8: 24
B9: 26
B10: -17
On aura un tableau Res comme ceci:

Res(1,1) = 3 (Première série commence en ligne 3)
Res(2,1)=3 (Première série a 3 valeurs positives)
Res(1,2)=8 (Deuxième série commence en ligne 8)
Res(2,2)=2 (deuxième série a 2 valeurs positives)

La fonction Fmax permet de calculer le maximum de chaque série (connaissant où elle commence et combien elle comporte de valeurs).

Je voudrais simplement récupérer une valeur du max pour chaque série positive

Que veux tu en faire?

[docjam71]

Ok j'ai compris,

Exemple pour la 1ère série positive, j'ai :

B2 : 0,12
B3 : 0,145
B4 : 0,1506
B5 : 0,22
Bn : 0,2

On récupère :

C2 : 0,22
C3 : 0,22
C4 : 0,22
C5 : 0,22
Cn : 0,22

Or je ne veux lisser ma courbe que pour une valeur max de chaque série positive.
Il me faut tracé pour chaque Ymax son X correspondant.

Merci.

[mercatog]

C'est à dire? avec ton exemple tu veux obtenir quoi?

[docjam71]

Bonsoir,

Je reviens vers vous pour mon histoire de lissage.

Je voudrais maintenant récupérer le min au lieu du max que le code de mercatog génère.

Ainsi : à partir de la 1ère variation où Yn-1 < Yn > Yn+1 jusqu'à la dernière variation où Yx-1 < Yx > Yx+1, me récupérer entre [Yn;Yx] le Ymin avec son X correspondant.

Et faire ça comme précédemment toujours pour les séries positives.

Je ne sais pas si je suis clair.

Merci.

[mercatog]

Bonsoir
C'est pourquoi il fallait comprendre le code
Pour trouver le min à la place du max, change > par < en ligne 19

[docjam71]

Bonjour,

Oui j'ai essayé de changer ce signe mais ça ne marche pas comme je le souhaite.
Je m'explique :

Si je change le signe en ligne 19, le code me récupère le point le plus petit. Or, j'ai un signal "carré" ou la crête varie comme des vagues irrégulières. Je voudrais récupérer le min dans cette partie haute du signal carré comme pour le max.

Donc le code doit calculé le min à partir de Xn+4 jusqu'à Xn-4 car je considère d'après mes signaux que la crête débute à partir du 4ième point et fini 4 points avant, c'est ainsi pour chaque signal.

Donc récupérer le Ymin pour X compris entre [Xn+4; Xn-4] et ainsi pour chaque série positive.

Merci.

Au final il me faudrait un code générale ou j'aurais à partir des donnés brute X et Y, 5 colonnes : Ymax avec son X, Ymin avec son X [Xn+4;Xn-4] et la moyenne de Ymin et Ymax.

[docjam71]

Bonjour,

Puis-je à partir des donnés brute X et Y généré 3 colonnes qui me donneront grâce à VB : Ymax avec son X, Ymin avec son X [Xn+4;Xn-4] et la moyenne de Ymin et Ymax?

Merci

[mercatog]

Une proposition
Colonne A: X, Colonne B: Y et le code génère en Colonne C: Y_Lissée
la courbe initiale Y est une courbe carrée avec alternance de créneaux positifs et autres négatifs.

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
Sub Lissage()
Dim LastLig As Long, i As Long, j As Long, k As Long
Dim dMn As Double, dMx As Double
Dim Tb
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    Tb = .Range("A1:C" & LastLig)
    Tb(1, 3) = "Y_Lissée"
    i = 2
    Do While i < LastLig
        If Tb(i, 2) * Tb(i + 1, 2) <= 0 Then                         'au cas de changement de signe des valeurs
            dMx = Mx(Tb, i - j, j)
            dMn = Mn(Tb, i - j, j)
            For k = i - j To i
                Tb(k, 3) = (dMx + dMn) / 2
            Next k
            j = 0
        Else
            j = j + 1
        End If
        i = i + 1
    Loop
    .Range("A1:C" & LastLig) = Tb
End With
End Sub
 
Private Function Mx(Tb, ByVal Deb As Long, Nb As Long) As Double
Dim M As Double
Dim k As Long
 
M = Tb(Deb, 2)
For k = Deb + 1 To Deb + Nb
    If Abs(Tb(k, 2)) > Abs(M) Then M = Tb(k, 2)
Next k
Mx = M
End Function
Private Function Mn(Tb, ByVal Deb As Long, Nb As Long) As Double
Dim M As Double
Dim k As Long
 
M = Tb(Deb, 2)
For k = Deb + 1 To Deb + Nb
    If Abs(Tb(k, 2)) < Abs(M) Then M = Tb(k, 2)
Next k
Mn = M
End Function

[docjam71]

Bonjour,

J'ai un signal "carré" ou la crête présente des vagues irrégulières. Je voudrais récupérer le min dans cette partie haute du signal carré comme pour le max du code Crêtes plus bas.

Donc le code doit calculé le min à partir de Xn+4 jusqu'à Xn-4 car je considère d'après mes signaux que la crête débute à partir du 4ième point et fini 4 points avant, c'est ainsi pour chaque signal.

Donc récupérer le Ymin pour X compris entre [Xn+4; Xn-4] et ainsi pour chaque série positive. La série négative ne m'intéresse pas.


Ton code me génère qu'une seule colonne, et j'obtiens un signal carré!

J'aurais voulu à partir des donnés brute X et Y, 3 colonnes en plus : Ymax avec son X, Ymin avec son X [Xn+4;Xn-4] et la moyenne de Ymin et Ymax.

Un code peut-il générer les 3 colonnes en même temps?

Merci

[mercatog]

Je suis entrain de faire un devoir surveillé (un fichier de données serait nécessaire).

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
Sub Lissage()
Dim LastLig As Long, i As Long, j As Long, k As Long
Dim dMn As Double, dMx As Double
Dim Tb
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    Tb = .Range("A1:E" & LastLig)
    Tb(1, 3) = "Y_Max": Tb(1, 4) = "Y_Min": Tb(1, 5) = "Y_Moy"
    i = 2
    Do While i < LastLig
        If Tb(i, 2) * Tb(i + 1, 2) <= 0 Then                         'au cas de changement de signe des valeurs
            dMx = Mx(Tb, i - j, j)
            dMn = Mn(Tb, i - j, j)
            For k = i - j To i
                Tb(k, 3) = dMx
                Tb(k, 4) = dMn
                Tb(k, 5) = (dMx + dMn) / 2
            Next k
            j = 0
        Else
            j = j + 1
        End If
        i = i + 1
    Loop
    .Range("A1:E" & LastLig) = Tb
End With
End Sub
 
Private Function Mx(Tb, ByVal Deb As Long, Nb As Long) As Double
Dim M As Double
Dim k As Long
 
M = Tb(Deb, 2)
For k = Deb + 1 To Deb + Nb
    If Abs(Tb(k, 2)) > Abs(M) Then M = Tb(k, 2)
Next k
Mx = M
End Function
Private Function Mn(Tb, ByVal Deb As Long, Nb As Long) As Double
Dim M As Double
Dim k As Long
 
M = Tb(Deb, 2)
For k = Deb + 1 To Deb + Nb
    If Abs(Tb(k, 2)) < Abs(M) Then M = Tb(k, 2)
Next k
Mn = M
End Function

[docjam71]

Bonjour,

Je ne veux récupérer que la valeur Max et Min pour chaque série positive avec leur X correspondant.

Il me faut tracé pour chaque Ymin son X correspondant comme le code Sub Crêtes plus haut qui marche nickel pour Ymax.

Sauf que je voudrais un code général qui génère le Ymax avec son X, le Ymin avec son X puis la moyenne de Ymin et Ymax.

Il y a donc 5 colonnes en plus des valeurs brutes X et Y.

Le dernier code me génère un signal carré or je veux lisser le signal que dans la partie haute de la crête pour chaque série positive.

Ci-joint un fichier de données.

Merci

[mercatog]

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
Sub Lissage()
Dim LastLig As Long, i As Long, j As Long, k As Long, n As Long
Dim dMn As Double, dMx As Double
Dim Tb
 
Application.ScreenUpdating = False
With Worksheets("Feuil5")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    Tb = .Range("A1:E" & LastLig)
    Tb(1, 3) = "Y_Max": Tb(1, 4) = "Y_Min": Tb(1, 5) = "Y_Moy"
    i = 2
    Do While i < LastLig
        If Abs(Tb(i + 1, 2) - Tb(i, 2)) > 0.1 * Tb(i, 2) Then          'au cas de changement de plus de 10%
            dMx = Mx(Tb, i - j, j)
            dMn = Mn(Tb, i - j, j)
            For k = i - j To i
                Tb(k, 3) = dMx
                Tb(k, 4) = dMn
                Tb(k, 5) = (dMx + dMn) / 2
            Next k
            j = 0
        Else
            j = j + 1
        End If
        i = i + 1
    Loop
    .Range("A1:E" & LastLig) = Tb
End With
End Sub
 
Private Function Mx(Tb, ByVal Deb As Long, Nb As Long) As Double
Dim m As Double
Dim k As Long
 
m = Tb(Deb, 2)
For k = Deb + 1 To Deb + Nb
    If Abs(Tb(k, 2)) > Abs(m) Then m = Tb(k, 2)
Next k
Mx = m
End Function
 
Private Function Mn(Tb, ByVal Deb As Long, Nb As Long) As Double
Dim m As Double
Dim k As Long
 
m = Tb(Deb, 2)
For k = Deb + 1 To Deb + Nb
    If Abs(Tb(k, 2)) < Abs(m) Then m = Tb(k, 2)
Next k
Mn = m
End Function

[docjam71]

Ok!

Mais sur la même logique que pour le code du lissage Max (voir code Crêtes plus haut et fichier données ci-joint) que cela donne t-il pour le lissage Min? restons à 10%.

Merci

Ci-joint fichier données.