Macro VBA de recherche et d'extraction de valeur

**mattchoco** · 15/06/2013, 19h04

l'analyse ne se fait que à partir de la ligne51, comme on avait fait au début.

on peut supprimer la ligne blanche de la ligne 54 et de la ligne 59 si ça pose soucis c'et pas important.

je vais faire un graph pour expliquer différemment , à tout de suite.

si l'on trace le graph correspondant aux colonnes A et B à partir de la ligne 51, on trouve ceci :

[IMG]

[/IMG]

j'aimerai récupérer la valeur de chaque pics qui sort du lot. ( on en vois trois nettement.

Donc une première condition pour récupérer les points supérieur à 0.1,

puis le max de chaque groupe trouvé, qui correspond donc à un pic.

**Daniel.C** · 15/06/2013, 22h12

J'ai (enfin) compris, du moins je crois. Essaie :

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
Sub test()
    Dim Ligne As Long, C As Range, Res As Double
    Ligne = 49
    For Each C In Range([B51], Cells(Rows.Count, 2).End(xlUp))
        If C > 0.1 Then
            If C > Res Then
                Res = C
            ElseIf C.Row > 50 Then
                Ligne = Ligne + 1
                Cells(Ligne, 7).Resize(, 4).Value = Cells(C.Row - 1, 1).Resize(, 4).Value
                Res = 0
            End If
        End If
    Next C
End Sub

**mattchoco** · 16/06/2013, 09h31

hello, dans les grandes lignes ç'est presque ça,

les deux premières valeurs sont ok,

mais la troisième non. la ligne relevée est la ligne précédent celle qui aurai du être relevée.
petite particularité , ce troisième groupe de valeurs n'est composée que de deux valeurs, je ne sais pas si ça a un impact.

si je comprend bien ta conception, tu compares ligne par ligne en regardant qui est plus grand que l'autre? c'est très astucieux comme approche, je n'y avais pas pensé. Comment définis tu ton Res par contre, c'est quelquechose de connu intrinsèquement?

[EDIT]

j'ai peut être trouvé le pourquoi du comment.

ne faudrait il pas faire un "reset" de la valeur de res entre chaque groupe de données?

je me demande si justement , la condition pour le troisième groupe n'est pas perturbée par les valeurs du deuxième groupe qui le précède.

**Daniel.C** · 16/06/2013, 11h51

On va y arriver...

Teste :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test1()
    Dim Ligne As Long, C As Range, Res As Double
    Ligne = 49
    For Each C In Range([B51], Cells(Rows.Count, 2).End(xlUp))
        If C > 0.1 And C > Res Then
            Res = C
        ElseIf Res > 0 And C.Row > 50 Then
                Ligne = Ligne + 1
                Cells(Ligne, 7).Resize(, 4).Value = Cells(C.Row - 1, 1).Resize(, 4).Value
                Cells(Ligne, 11) = C.Row
                Res = 0
        End If
    Next C
End Sub

**mattchoco** · 16/06/2013, 12h38

ça a résolu le problème précédant mais.. ça en a créé un autre, pour le pic 2 j'ai deux valeurs ( dont la bonne d'ailleurs)

la macro me renvoi quatre lignes alors qu'elle ne devrait me détecter uniquement 3 pics.

est ce qu'il y a possibilité d'imposer une condition de passage à 0?

ou bien de poser une condition sur : la valeur précédente est inférieur ET la valeur suivante est aussi inférieur ? ( cela permettrait de détecter les pic à chaque fois non?

la deuxième serait l'idéal je pense.

**Daniel.C** · 16/06/2013, 13h22

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
Sub test2()
    Dim Ligne As Long, Lig As Long, Res As Double
    Ligne = 49
    [G:K].ClearContents
    For i = 51 To Cells(Rows.Count, 2).End(xlUp).Row
        If Cells(i, 2).Row = 234 Then Stop
        If Cells(i, 2) > 0.1 Then
            Res = 0
            Do Until Cells(i, 2) < 0.1
                If Cells(i, 2) > Res Then
                    Res = Cells(i, 2)
                    Lig = Cells(i, 2).Row
                End If
                i = i + 1
            Loop
            Ligne = Ligne + 1
            Cells(Ligne, 7).Resize(, 4).Value = Cells(Lig, 1).Resize(, 4).Value
            Cells(Ligne, 11) = Cells(Lig, 2).Row
        End If
    Next i
End Sub

**mattchoco** · 16/06/2013, 14h42

la macro s’arrête sur le "Then STOP"

à quoi correspond ta condition "234" ?

[EDIT]

par contre si j'enlève la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Cells(i, 2).Row = 234 Then Stop

ça a l'air de marcher très bien ! /D /D

**SfJ5Rpw8** · 16/06/2013, 14h48

actionne la touche F5 lors de l'arrêt ... ou supprime la ligne ... Daniel à du mettre cette ligne pour effectuer une pause dans le code et ainsi debuggger ton code lors du traitement de cette ligne 234..

**Daniel.C** · 16/06/2013, 15h00

Merci bbil; quand ça veut pas rire...

**mattchoco** · 16/06/2013, 15h44

Envoyé par Daniel.C

Merci bbil; quand ça veut pas rire...

écoute super, je viens de la tester sur plusieurs fichiers et ça a l'air de marcher niquel.

Il ne me reste plus qu'à comprendre les lignes de commande que tu as utilisées pour pérenniser le savoir et ça c'est pas gagner..

**Daniel.C** · 16/06/2013, 16h10

J'ai mis quelques commentaires, si ça peut t'aider...

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
Sub test2()
    Dim Ligne As Long, Lig As Long, Res As Double
    Ligne = 49
    'On efface la zone d'écriture
    [G:K].ClearContents
    'boucle sur les cellules de la colonne B de la ligne 51 à la dernière
    For i = 51 To Cells(Rows.Count, 2).End(xlUp).Row
        'si la cellule est > 0,1
        If Cells(i, 2) > 0.1 Then
            'on remet "Res" à 0
            Res = 0
            'boucle jusqu'à ce que la cellule soit < 0,1
            Do Until Cells(i, 2) < 0.1
                'Si la cellule est supérieure à Res
                If Cells(i, 2) > Res Then
                    'on met la valeur de la cellule dans Res...
                    'et la ligne de la cellule dans Lig
                    Res = Cells(i, 2)
                    Lig = Cells(i, 2).Row
                End If
                'on incrémente i
                i = i + 1
            Loop
            '"Ligne" représente la ligne où on écrit le résultat
            Ligne = Ligne + 1
            'copie des résultats
            Cells(Ligne, 7).Resize(, 4).Value = Cells(Lig, 1).Resize(, 4).Value
        End If
    Next i
End Sub

**mattchoco** · 16/06/2013, 16h44

ok, comme ça c'est très clair. Il me reste quelques petits points d'ombres, mais je devrais les trouver.

[EDIT]

ça y ai, j'en ai fait le tour..

mais ça m'a permis de voir la faille de cette approche

si on prend le cas suivant : ( l'échelle des ordonnées a été volontairement ramené à 0.1)
[IMG]

[/IMG]

on remarque au milieu un groupe de quatre pics.

il faudrait que la macro me renvoi une valeur pour les quatre pics, mais comme ( et c'est ma faute) la condition de boucle est aussi sur le passage de la valeur 0.1, en l'état la macro groupe les deux derniers pics et ne renvoi qu'une valeur.

Est il possible de faire une condition d'encadrement de valeur?

**mattchoco** · 25/06/2013, 15h21

Alors j'ai tenté la modif suivante :

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
Sub Bouton1_Cliquer()
 
 
 
    Dim Ligne As Long, Lig As Long, Res As Double
    Ligne = 49
    'On efface la zone d'écriture
    [G:K].ClearContents
    'boucle sur les cellules de la colonne B de la ligne 51 à la dernière
    For i = 51 To Cells(Rows.Count, 2).End(xlUp).Row
        'si la cellule est > 0,1
        If Cells(i, 2) > 0.1 Then
            'on remet "Res" à 0
            Res = 0
            'boucle jusqu'à ce que la cellule soit < res
            Do Until Cells(i, 2) > Res
 
                    'on met la valeur de la cellule dans Res...
                    'et la ligne de la cellule dans Lig
                    Res = Cells(i, 2)
                    Lig = Cells(i, 2).Row
 
                'on incrémente i
                i = i + 1
            Loop
            '"Ligne" représente la ligne où on écrit le résultat
            Ligne = Ligne + 1
            'copie des résultats
            Cells(Ligne, 7).Resize(, 4).Value = Cells(Lig, 1).Resize(, 4).Value
        End If
    Next i
End Sub

j'ai donc supprimé la deuxième condition " tant que supérieur à 0.1

et supprimé un if sur " if cells > Res

résultat des courses : ça m'affiche un beug sur la dernière ligne , la ligne de copies des résultats.

Je ne vois pas pourquoi, sachant que cette opération n'a pas été modifiée.

Vous voyez l’erreur?

**Daniel.C** · 25/06/2013, 17h20

J'ai vérifié avec mon code et les valeurs suivantes (ajoutées à la suite de celles que tu as fournies) :

1 0.11
2 0.12
3 0.15
4 0.11
5 0.16
6 0.06

et j'obtiens la seule ligne 5 (0,16).
Ou j'ai mal compris ce que tu voulais ?

**mattchoco** · 29/06/2013, 12h04

Pour cette suite de valeurs, il faudrait que la macro renvoi

3 0.15

5 0.16

Cordialement

[EDIT]
je crois que j'ai compris l'incompréhension

[IMG]

[/IMG]

sur le graph ci dessous on voit deux pics qui sont supérieur à 0.1 ( attention à l’échelle raccourcie).

La macro actuelle ne me renvoi qu'un seul pic car il y a la condition "détection du max" couplé à la condition "supérieur à 0.1".

Or il faudrait que la macro me renvoi la valeur des deux pics.

Si je reprend les deux pics , j'aurais les valeurs ( en simplifiant)
1 0.001
2 0.135
3 0.105
4 0.109
5 0.132
6 0.001

Il faudrait que la macro me renvoi les lignes:

2 0.135
et
5 0.132

Donc mon idée, était de faire une première condition > 0.1,

puis une boucle en comparant les valeurs une par une avec sa précédente, en regardant qui est la plus grande on peux sans doute retrouver les maxs.

**Daniel.C** · 29/06/2013, 15h37

Bonjour,

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
Sub test2()
    Dim Ligne As Long, Lig As Long, Res As Double
    Ligne = 49
    'On efface la zone d'écriture
    [G:K].ClearContents
    'boucle sur les cellules de la colonne B de la ligne 51 à la dernière
    For i = 51 To Cells(Rows.Count, 2).End(xlUp).Row
        'si la cellule est > 0,1
        If Cells(i, 2) > 0.1 Then
            'on remet "Res" à 0
            Res = 0
            'boucle jusqu'à ce que la cellule soit < 0,1
            Do Until Cells(i, 2) < 0.1
                'Si la cellule est supérieure à Res
                If Cells(i, 2) > Cells(i - 1, 2) And Cells(i, 2) > Cells(i + 1, 2) Then
                    'on met la valeur de la cellule dans Res...
                    'et la ligne de la cellule dans Lig
'                    Res = Cells(i, 2)
                    Lig = Cells(i, 2).Row
                    '"Ligne" représente la ligne où on écrit le résultat
                    Ligne = Ligne + 1
                    'copie des résultats
                    Cells(Ligne, 7).Resize(, 4).Value = Cells(Lig, 1).Resize(, 4).Value
                End If
                'on incrémente i
                i = i + 1
            Loop
        End If
    Next i
End Sub

**mattchoco** · 29/06/2013, 16h13

yes! ça a l'air de marcher !!
donc la solution était dans le IF AND... génial !!

merci, grand merci.

[EDIT]

j'ai fait plusieurs tests grandeurs natures et tout à l'air de marcher de manière impeccable.

Petite question complémentaire , le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.WorksheetFunction.Large(Maplage, 10)

me renvoi la dixième valeur max de ma colonne (Maplage)? est ce bien ça?

est ce que je dois l'intégrer comme condition si je veux extraire les dixième, onzième et douzième ligne correspondantes dans ma plage? ( toujours dans le même esprit que le problème précédent..)

**Daniel.C** · 29/06/2013, 18h04

Tout juste.

**mattchoco** · 29/06/2013, 18h22

ok, on va essayer d'appliquer ce que j'ai appris alors !

qu'en penses tu?

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
Sub Bouton7_Cliquer()
 
Dim Ligne As Long, Lig As Long, Res As Double
    Ligne = 50
    'On efface la zone d'écriture
    [G:K].ClearContents
 
    'je défini deux variables RES1 et RES2 correspondant au dixième et onzième valeur de ma colonne
 
 
    Res1 = Application.WorksheetFunction.Large(Maplage, 10)
 
    Res2 = Application.WorksheetFunction.Large(Maplage, 11)
 
        'boucle sur les cellules de la colonne 13 de la ligne 51 à la dernière
 
    For i = 51 To Cells(Rows.Count, 13).End(xlUp).Row
 
 
                'Si la cellule est égale à Res 1
                If Cells(i, 13) = Res1 Then
                    'on met la valeur de la le ligne de la cellule dans Lig...
 
                    Lig = Cells(i, 13).Row
                    '"Ligne" représente la ligne où on écrit le résultat
                    Ligne = Ligne + 1
                    'copie des résultats
                    Cells(Ligne, 16).Resize(, 13).Value = Cells(Lig, 1).Resize(, 13).Value
 
                If Cells(i, 13) = Res2 Then
 
                    Lig = Cells(i, 13).Row
                    '"Ligne" représente la ligne où on écrit le résultat
                    Ligne = Ligne + 1
                    'copie des résultats
                    Cells(Ligne, 16).Resize(, 13).Value = Cells(Lig, 1).Resize(, 13).Value
 
 
                End If
                'on incrémente i
                i = i + 1
            Loop
        End If
    Next i
End Sub