Bonjour,
j'aimerai savoir si on peut mieux optimisé ce programme en supprimant certaines boucles en écriture/Lecture .
Merci d'avance.


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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
Sub Alpha()    
 
'Déclaration des variables
 
Dim t As Double
Dim i As Integer, Min As Integer, MinValue As Double, j As Integer, k As Integer, m As Integer, p As Integer, x As Integer, y As Integer, l As Integer, epsi As Double, N() As Integer, T() As Integer, s As Integer
epsi = 0.1
x = 20
ReDim Tf(1 To x) As Integer
Application.ScreenUpdating = False   
Application.Calculation = xlCalculationManual  
 
t = Timer   'pr évaluer le temps machine
Range("F1") = Application.Round((Timer - t), 1) & "Sec"
 
 
 
 s = 1
 
For i = 1 To x
 T(i) = ActiveSheet.Cells(i, s)   
 
 Next i
Min = 1
MinValue = T(Min)
 
For i = 2 To x
  If T(i) < MinValue Then
  Min = i
   MinValue = T(i)
   End If
 
Next i
 
 ActiveSheet.Cells(1, s + 1) = Min
 
 
   ReDim N(1 To UBound(T)) As Integer
 
   i = 1
 
   For j = Min To UBound(T)
    N(i) = Tf(j)
    i = i + 1
    'Exit For
    Next j
 
m = Min - 1
 
For k = 1 To m
 N(i) = T(k)
 i = i + 1
 'Exit For
 Next k
 
 For k = 1 To UBound(Tf)
 ActiveSheet.Cells(k, s + 2) = N(k)
 
  Exit For
  Next k
 
For i = 1 To x
 
  T(i)=ActiveSheets(i,s+2).Value
  Exit For
Next i
 
  l = 1
  k = 0 'nombre de doublons
For j = 1 To UBound(Tf) - 1
  If Abs(T(j + 1) - T(j)) > epsi Then
  N(l) = T(j)
  l = l + 1
  Else
  k = k + 1
 
  End If
Next j
N(l) = T(UBound(T))
 
 y = x - k
 
 ReDim Preserve N(1 To y)
 For i = 1 To y
 
 
    ActiveSheet.Cells(k, s + 3) = N(i)
    Exit For
 Next i
 
 
 
 
 ''Définition de la plage des résultats
 
For i = 1 To y
 T(i) = ActiveSheet.Cells(i, s + 3)
Next i
 i = 2
 p = 0
 N(1) = T(1)
 
For j = 2 To UBound(T) - 1
 
If (T(j - 1 - p) - T(j)) < 0 And (T(j) - T(j + 1)) > 0 Or (T(j - 1 - p) - T(j)) > 0 And (T(j) - T(j + 1)) < 0 Then
 
   N(i) = T(j)
   i = i + 1
   p = 0
Else
  p = p + 1
 
     End If
 
 Next j
 
   N(i) = T(UBound(f))
 
 For j = 1 To i
 
    ActiveSheet.Cells(j, s + 4) = N(j)
Exit For
 Next j
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 MsgBox Timer - t
 
 Erase Tf
 Exit Sub
End Sub