Bonjour,
Pour te donner une piste:
J'ai supposé: une série1 colonne 1et2
une série2 colonne 3et4
une série3 cumul 5et6
Principe : pour chaque x de série 1 et 2 calcul du y intersection avec les autres séries et cumul.
Produit non optimisé, non généralisé, problèmes aux limites non vraiment traités, seulement base de départ. Je suis intéressé par le produit terminé.
Function intersect(x As Double, colx As Integer, coly As Integer, np As Integer) As Double
For i = 1 To np
If x <= Cells(i, colx) Then Exit For
Next i
If i >= np Or i = 1 Then
intersect = Cells(i, coly)
Exit Function
Else
x1 = Cells(i - 1, colx)
y1 = Cells(i - 1, coly)
x2 = Cells(i, colx)
y2 = Cells(i, coly)
End If
If x2 <> x1 Then
intersect = y1 + ((x - x1) * (y2 - y1)) / (x2 - x1)
Else
intersect = y1
End If
End Function
Sub cum()
Dim xx As Double
Dim cocox As Integer
Dim cocoy As Integer
Dim nbp As Integer
nbcou = 2
nbp = 7
yy = 0
'14= nbcou*nbp
Dim tata(2, 14)
Range("a1" ).Select
Sheets(1).Activate
For j = 1 To nbcou
For i = 1 To nbp
For ij = 1 To nbcou
cocox = 1 + 2 * (ij - 1)
cocoy = cocox + 1
xx = ActiveSheet.Cells(i, 1 + 2 * (j - 1)).Value
yy = yy + intersect(xx, cocox, cocoy, nbp)
indj = i + 7 * (j - 1)
Next ij
tata(1, indj) = xx
tata(2, indj) = yy
yy = 0
Next i
Next j
For j = 1 To nbcou
For i = 1 To nbp
indj = i + 7 * (j - 1)
Cells(indj, 5) = tata(1, indj)
Cells(indj, 6) = tata(2, indj)
Next i
Next j
Columns("E:F" ).Select
Selection.Sort Key1:=Range("E1" ), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Cordialement