Bonjour je bloque sur un programme complexe à réaliser là.

Je souhaite détecter des écarts dans mes données (colonne 1 de ma feuille excel "données").
Voici les éléments qui composent mon userform:

1 textbox precision
5 checkbox
1 bouton valider

Voici mes écarts (ce sont des checkbox à cocher sur mon userform):

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
a = 1
b = 2
c = 3 
d = 4 
e = 5


Voici un exemple de données de ma colonne 1:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
15
16
18
21
26

Je prend la 1ere masse et je souhaite détecter un écart de "c" (je coche le checkbox c):

15+c=18 ---> je cherche 18 dans ma colonne 1, si je trouve c'est bon sinon je passe à la données suivante
18+c=21 ---> je cherche 21 dans ma colonne 1, si je trouve c'est bon sinon je passe à la données suivante
21+c=24 ----> je cherche 24 dans ma colonne 1, il n'y a pas de 24 donc je continue le même teste avec la deuxieme ligne
16+c=19 ---> je cherche 19 dans ma colonne 1, il n'y a pas de 19 donc je continue le même teste avec la deuxieme ligne

etc etc

mes données deviendront:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
15   
18  ecart=c
21  ecart=2*c

Les autres seront supprimées car aucun écart aura été détecté.


Deuxième exemple, je coche c et d (c=3 et d=4)

Voici un exemple de données de ma colonne 1:


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
50
51
53
54
56
57
58
Je devrais avoir:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
50
53  ecart=c	
54  ecart=d
56  ecart=2*c
57  ecart=d par rapport à 53
Voilà voilà c'est "juste" une détection mathématiques à faire mais que je n'arrive pas à réaliser.

En somme je dois faire une détection d'ecart pour les checkbox coché (a,b ,c ,d ou e) par rapport à ma 1ere valeur (50 dans le deuxieme exemple). Si je trouve du c et du e (en ayant coché "c" et "e" bien sur) je dois faire le meme test en partant du 1er "c" trouvé (ici 53) et chercher du "d" (57).

Si vous ne comprenez pas tout, j'essayerai de détailler un peu plus.

Voici mon code qui ne fonctionne pas malheureusement et que je n'ai adapté pour l'instant qu'au "a".


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
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
Sub detection()
 
Dim a As Double, b As Double, c As Double, d As Double, e As Double 'constante a detecter
Dim derniereligne As Integer
 
Dim ainf As Double, asup As Double 'borne inférieur et superieur de a
Dim binf As Double, bsup As Double
Dim cinf As Double, dsup As Double
Dim dinf As Double, dsup As Double
Dim einf As Double, esup As Double
dim test as boolean
dim exist as boolean
 
Dim Delta As Double ' marge à appliquer
 
 
''''''''''''''''' ecart a detecter'''''''''''''''''''''''''
a = 1 
b = 2
c = 3 
d = 4 
e = 5 
 
derniereligne = Sheets("Données").Range("A65536").End(xlUp).Row ' ma derniereligne de mes données
precision = Val(UserForm1.TextBox1.Value)   ' precision que je rentre dans mon textbox
 
If abox.value=true or bbox.value=true or cbox.value=true or dbox.value=true or ebox.value=true then  ' mes checkbox a cocher
 
		For i = 2 To derniereligne
			Delta = (precision * Cells(i, 1)) / 10 ^ 6   ' delta 
			Cells(i, 3) = Delta  ' je mets mon delta dans la colonne 3
 
			ainf = Cells(i, 1) + a - Delta ' borne inférieur de a
			asup = Cells(i, 1) + a + Delta 'borne supérieur de a
 
			binf = Cells(i, 1) + b - Delta ' borne inférieur de b
			bsup = Cells(i, 1) + b + Delta 'borne supérieur de b
 
			cinf = Cells(i, 1) + c - Delta ' borne inférieur de c
			csup = Cells(i, 1) + c + Delta 'borne supérieur de c
 
			dinf = Cells(i, 1) + d - Delta ' borne inférieur de d
			dsup = Cells(i, 1) + d + Delta 'borne supérieur de d
 
			einf = Cells(i, 1) + e - Delta ' borne inférieur de e
			esup = Cells(i, 1) + e + Delta 'borne supérieur de e
 
 
       For j = i + 1 To derniereligne
 
                dif = Abs(Sheets("données").Cells(i, 1) - Sheets("données").Cells(j, 1))
 
                If (dif <asup And dif > ainf) Then
 
                    test = False
 
                    exist = False
                    'regarde si la valeur a déjà été trouvé
                    For n = 3 To k
                        If Sheets("Feuil2").Cells(n, 1) = Sheets("données").Cells(j, 1) Then
                            exist = True
                        End If
                    Next n
                    If Not exist Then
                        Sheets("données").Rows(j).Copy Sheets("Feuil2").Rows(k)
                        Sheets("Feuil2").Rows(k).Font.ColorIndex = 3
                        Sheets("données").Rows(j).Copy Sheets("Feuil2").Rows(k)
                        Sheets("Feuil2").Rows(k).Font.ColorIndex = 3
                        k = k + 1
                    End If
                    ' test la deuxième valeur
                    exist = False
                    For n = 3 To k
                        If Sheets("Feuil2").Cells(n, 1) = Sheets("données").Cells(i, 1) Then
                            exist = True
                        End If
                    Next n
                    If Not exist Then
                        Sheets("données").Rows(i).Copy Sheets("Feuil2").Rows(k)
                        Sheets("Feuil2").Rows(k).Font.ColorIndex = 3
                        Sheets("données").Rows(i).Copy Sheets("Feuil2").Rows(k)
                        Sheets("Feuil2").Rows(k).Font.ColorIndex = 3
                        k = k + 1
 
                    End If
                End If
        Next j
	Next i
 
end if
End Sub
p.s.: je travaille sur l'écriture d'un algorithme qui pourrait me sortir toutes les possibilités