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
| Option Explicit
Sub TRACER()
Dim Ch As ChartObject
Dim LastLig As Long
Dim Tbl
With Worksheets("Feuil1")
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
Tbl = DATA(.Range("A1:C" & LastLig))
Set Ch = .ChartObjects.Add(300, 200, 500, 300)
End With
With Ch.Chart
.ChartType = xlXYScatterLines
With .SeriesCollection.NewSeries
.XValues = Application.Index(Tbl, , 1)
.Values = Application.Index(Tbl, , 2)
End With
End With
Set Ch = Nothing
End Sub
Private Function DATA(ByVal Rng As Range)
Dim n As Long, i As Long, j As Long, k As Long
Dim Temp() As Double, Res() As Double
Dim Tb
Tb = Rng.Value
n = UBound(Tb, 1)
ReDim Temp(1 To 2 * n, 1 To 3)
For i = 1 To n
j = 2 * i - 1
Temp(j, 1) = Tb(i, 1)
Temp(j, 2) = Tb(i, 2)
Temp(j + 1, 1) = Tb(i, 1) + Tb(i, 3)
Temp(j + 1, 2) = -1 * Tb(i, 2)
Next i
TriRapide Temp, 1, 2 * n
Cumul Temp
ReDim Res(1 To 4 * n, 1 To 2)
For i = 1 To 4 * n
j = (i + 1) \ 2
k = 1 + i \ 2
Res(i, 1) = Temp(j, 1)
If k <= 2 * n Then Res(i, 2) = Temp(k, 3)
Next i
DATA = Res
End Function
Private Sub TriRapide(ByRef T, ByVal P As Long, ByVal D As Long)
Dim Tmp As Double, m As Double
Dim Lo As Long, Hi As Long
Dim k As Byte
Lo = P
Hi = D
m = T((P + D) / 2, 1)
Do
Do While (T(Lo, 1) < m)
Lo = Lo + 1
Loop
Do While (T(Hi, 1) > m)
Hi = Hi - 1
Loop
If (Lo <= Hi) Then
For k = 1 To 2
Tmp = T(Lo, k)
T(Lo, k) = T(Hi, k)
T(Hi, k) = Tmp
Next k
Lo = Lo + 1
Hi = Hi - 1
End If
Loop While (Lo <= Hi)
If (P < Hi) Then TriRapide T, P, Hi
If (Lo < D) Then TriRapide T, Lo, D
End Sub
Private Sub Cumul(T)
Dim i As Long, m As Long
Dim S As Double
m = UBound(T, 1)
For i = 2 To m
S = S + T(i - 1, 2)
T(i, 3) = S
Next i
End Sub |
