Sub TableApres()
Dim R As Range
Dim var
Dim i&
Dim j&
Dim k&
Dim Ordo&
Dim pos&
Dim T()
Dim x#
Dim S As Worksheet
Dim C As Chart
Dim A$
Set R = Selection
If R.Columns.Count <> 4 Then
MsgBox "La plage sélectionnée n'a pas 4 colonnes."
Exit Sub
End If
var = R
For i& = 1 To UBound(var, 1)
For j& = 2 To UBound(var, 2)
If var(i&, j&) <> "" Then Ordo& = Ordo& + 1
Next j&
Next i&
ReDim T(1 To Ordo&, 1 To 2)
'--- Calcul des données ---
For i& = 1 To UBound(var, 1)
pos& = i& + 2 * (i& - 1)
For j& = 1 To UBound(var, 2)
If j& = 1 Then
T(pos&, 1) = var(i&, j&)
Else
If pos& + k& <= Ordo& Then
T(pos& + k&, 2) = var(i&, j&)
k& = k& + 1
End If
End If
Next j&
k& = 0
Next i&
j& = 2
For i& = 1 To Ordo& - 1 Step 3
x# = T(i& + 3, 1) - T(i&, 1)
T(j&, 1) = T(i&, 1) + (x# * 1 / 3)
T(j& + 1, 1) = T(i&, 1) + (x# * 2 / 3)
j& = j& + 3
Next i
'--- Inscription ---
Set S = Sheets.Add
Set R = S.Range(S.Cells(1, 1), S.Cells(UBound(T, 1), 2))
R = T
R.NumberFormat = "0.00"
A$ = R.Parent.Name
Set C = Charts.Add
C.ChartType = xlXYScatterSmooth
Set R = R.Resize(R.Rows.Count, R.Columns.Count - 1)
C.SeriesCollection(1).XValues = "=" & A$ & "!" & _
R.Address(False, False, xlR1C1) & ""
Set R = R.Offset(0, 1)
C.SeriesCollection(1).Values = "=" & A$ & "!" & _
R.Address(False, False, xlR1C1) & ""
C.Location Where:=xlLocationAsObject, Name:=A$
With ActiveChart
.Axes(xlValue).MajorUnit = 0.5
.Deselect
End With
End Sub