Discussion :

[dafchap]

Bonjour,

le titre est un peu confus alors voilà en image ce que je cherche à faire



et voila mon code qui permet de traiter une partie des données seulement

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
 
Sub Blabla()
 
Dim dl, i, j, arrondi As Integer
Dim Pas As Double
 
dl = 30
Pas = 0.5
 
i = 3
j = i + 1
 
'---------Marche très bien pour garder la valeur la plus proche du pas.
 
Do While Cells(i, 1) - Cells(j, 1) < Pas
 
    ' Si des 2 valeurs supérieure au pas la première est plus proche
    ' de la valeur exacte de la première cellule (cells i,1) moins le pas
    'alors exclure cette valeur de la suppression sinon la supprimer et garder la deuxième
    If (Cells(j + 1, 1) + Cells(j, 1)) / 2 < Cells(i, 1) - Pas Then
        Range(Cells(i + 1, 1), Cells(j - 1, 2)).Font.Color = RGB(192, 32, 255) 'coloration des C supprimées
        arrondi = 1 ' marqueur pour déterminer où arrondir
    ElseIf (Cells(j + 1, 1) + Cells(j, 1)) / 2 >= Cells(i, 1) - Pas Then
        Range(Cells(i + 1, 1), Cells(j, 2)).Font.Color = RGB(192, 32, 255) 'coloration des cellules supprimées
       arrondi = 0 ' marqueur pour déterminer où arrondir
    End If
 
 
       j = j + 1
    Loop
'--------------------------------------------
 
'------------------------------------
 
If arrondi = 1 Then
    Cells(j - 1, 1) = Round(Cells(j - 1, 1), 1)
ElseIf arrondi = 0 Then
    Cells(j, 1) = Round(Cells(j, 1), 1)
End If
End Sub

En fait j'aimerais, comme vous l'aurez sans doute compris, relancer la boucle while une fois qu'elle arrive à sa condition de fin, mais je ne sais pas comment faire.
Et peut-être qu'il y a une autre méthode moins compliquée pour arriver à mes fins, mais que je ne connais pas.

Bref si quelqu'un pouvait m'aider à appliquer le même traitement à la suite de mes données, ce serait super !

Merci d'avance pour votre aide,

David

[dafchap]

Et du coup étant donné qu'on m'a fait cette réflexion judicieuse pour un autre sujet je vous mets une partie des données en dessous si besoin.

Données à traiter

Abscisses	Ordonnées
124	1,47
123,97	1,462
123,88	1,468
123,8	1,449
123,71	1,463
123,63	1,449
123,53	1,45
123,48	1,456
123,38	1,459
123,29	1,459
123,21	1,451
123,12	1,451
123,04	1,463
122,96	1,467
122,88	1,461
122,79	1,457
122,71	1,478
122,62	1,48
122,54	1,463
122,45	1,473
122,38	1,459
122,29	1,485
122,21	1,458
122,12	1,488
122,04	1,49
121,95	1,476
121,87	1,49
121,78	1,478
121,7	1,484
121,62	1,485
121,53	1,499
121,45	1,493
121,36	1,492
121,28	1,509
121,19	1,506
121,12	1,5
121,03	1,492
120,95	1,508
120,86	1,5
120,78	1,495
120,69	1,496
120,61	1,498
120,52	1,506
120,44	1,494
120,36	1,503
120,27	1,502
120,19	1,508
120,1	1,512
120,02	1,501

[dafchap]

Bon. Je suis débile, il suffisait d'insérer cette boucle while dans une autre boucle while. Voici donc mon code, mais il y a encore des défauts tels que :
- l'arrondi qui se fait sur des valeurs supérieures au "Pas" ex (124/123.5/123/122.5/122.1...là ça coince)
- les valeurs supprimées (rosées) qui inclue les valeurs à ne pas supprimer (valeur ci-dessus)

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
 
Sub Blabla()
 
Dim dl, i, j, arrondi As Integer
Dim Pas As Double
 
dl = 50 'nombre de lignes à analyser
Pas = 0.5 'pas à garder entre chaque valeur
 
i = 3
j = i + 1
 
Do While i < dl
 
 
    Do While Cells(i, 1) - Cells(j, 1) < Pas
 
        ' Si des 2 valeurs supérieure au pas la première est plus proche
        ' de la valeur exacte de la première cellule (cells i,1) moins le pas
        'alors exclure cette valeur de la suppression sinon la supprimer et garder la deuxième
        If (Cells(j + 1, 1) + Cells(j, 1)) / 2 < Cells(i, 1) - Pas Then
            Range(Cells(i + 1, 1), Cells(j - 1, 2)).Font.Color = RGB(192, 32, 255) 'coloration des C supprimées
            arrondi = 1 ' marqueur pour déterminer où arrondir
        ElseIf (Cells(j + 1, 1) + Cells(j, 1)) / 2 >= Cells(i, 1) - Pas Then
            Range(Cells(i + 1, 1), Cells(j, 2)).Font.Color = RGB(192, 32, 255) 'coloration des cellules supprimées
           arrondi = 0 ' marqueur pour déterminer où arrondir
        End If
 
 
           j = j + 1
    Loop
 
 
'------------------------------------
 
If arrondi = 1 Then
    Cells(j - 1, 1) = Round(Cells(j - 1, 1), 1)
ElseIf arrondi = 0 Then
    Cells(j, 1) = Round(Cells(j, 1), 1)
End If
 
i = j - 1
MsgBox i
 
Loop
End Sub

[dafchap]

Finalement...pour ceux qui auront peut-être un jour le même problème, voici le code qui m'a permis de faire ce que je voulais :

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 Blabla()
 
Dim dl, i, j, arrondi As Integer
Dim Pas As Double
 
dl = 50
Pas = 4
 
i = 3
j = i + 1
 
Do While i < dl
 
'---------Cette boucle permet de supprimer les valeurs contenues dans le Pas défini
 
    Do While Cells(i, 1) - Cells(j, 1) < Pas
 
        ' Si des 2 valeurs supérieure au pas la première est plus proche
        ' de la valeur exacte de la première cellule (cells i,1) moins le pas
        'alors exclure cette valeur de la suppression sinon la supprimer et garder la deuxième
        If (Cells(j + 1, 1) + Cells(j, 1)) / 2 <= Cells(i, 1) - Pas Then
        'important de mettre le = sur cette condition pour ne pas supprimer la valeur arrondie
        ' quand Cells(j + 1, 1) + Cells(j, 1)) / 2 = (exactement) Cells(i, 1) - Pas
            Range(Cells(i + 1, 1), Cells(j - 1, 2)).Font.Color = RGB(192, 32, 255) 'coloration des C supprimées
            arrondi = 1 ' marqueur pour déterminer où arrondir
        ElseIf (Cells(j + 1, 1) + Cells(j, 1)) / 2 > Cells(i, 1) - Pas Then
            Range(Cells(i + 1, 1), Cells(j, 2)).Font.Color = RGB(192, 32, 255) 'coloration des cellules supprimées
           arrondi = 0 ' marqueur pour déterminer où arrondir
        End If
 
 
           j = j + 1
    Loop
'------------------------------------
 
 
'---------------selon le marqueur on arrondi la valeur immédiatement inférieure ou supérieure au Pas
'de même on fixe i pour que la boucle while reprenne sa course au "bon endroit"
If arrondi = 1 Then
    Cells(j - 1, 1) = Round(Cells(j - 1, 1), 1)
    i = j - 1
ElseIf arrondi = 0 Then
    Cells(j, 1) = Round(Cells(j, 1), 1)
    i = j
End If
 
 
Loop
End Sub

Le défaut de mon code c'est qu'on ne peut pas traiter les données avec un Pas plus petit que la différence entre la valeur d'une cellule (j,1) et d'une cellule (j+5,1).

[dafchap]

Voici le code corrigé de ses défauts :

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 Nettoyage()
 
Dim dl, i, j, arrondi As Integer
Dim Pas As Double
 
dl = 50 ' dernière ligne des données à traiter
Pas = 0.2
 
i = 3
j = i + 1
 
Do While i < dl
 
'---------La BOUCLE ci-dessous permet de supprimer les valeurs contenues dans le Pas défini
 
    Do While Cells(i, 1) - Cells(j, 1) < Pas 'boucler jusqu'à ce que la dernière cellule > première C + Pas
 
        ' Si des 2 valeurs supérieure au pas la première est plus proche
        ' de la valeur exacte de la première cellule (cells i,1) moins le pas
        'alors exclure cette valeur de la suppression sinon la supprimer et garder la deuxième
        If (Cells(j + 1, 1) + Cells(j, 1)) / 2 <= Cells(i, 1) - Pas Then
        'important de mettre le = sur cette condition pour ne pas supprimer la valeur arrondie
            arrondi = 1 ' marqueur pour déterminer où arrondir et quelles cellules supprimer
        ElseIf (Cells(j + 1, 1) + Cells(j, 1)) / 2 > Cells(i, 1) - Pas Then
           arrondi = 0 ' marqueur pour déterminer où arrondir et quelles cellules supprimer
        End If
 
 
           j = j + 1
    Loop
'------------------------------------
'Une fois qu'on a passé en revue toutes les cellules dont la valeur est contenu dans le Pas on sort de la boucle
 
'---------------selon le marqueur on arrondi la valeur immédiatement inférieure ou supérieure au Pas
' on supprime les cellules adéquates
'de même on fixe i pour que la boucle while reprenne sa course au "bon endroit"
If arrondi = 1 Then
    Cells(j - 1, 1) = Round(Cells(j - 1, 1), 1)
    Range(Cells(i + 1, 1), Cells(j - 2, 2)).Font.Color = RGB(192, 32, 255)
    i = j - 1
ElseIf arrondi = 0 Then
    Cells(j, 1) = Round(Cells(j, 1), 1)
    Range(Cells(i + 1, 1), Cells(j - 1, 2)).Font.Color = RGB(192, 32, 255)
    i = j
End If
 
 
Loop
End Sub