Function PolyAC(ByVal MatX As Range, ByVal MatY As Range, ByVal MatXC As Range, ByVal MatYC As Range, ByVal N As Long, Optional ByVal I As Variant = 1) 'Calcul du coefficient "Ci" de l'équation polynomiale de degré n 'calculé par les moindres carrés des points donnés Pt(xi,yi) 'Soit xi = matx et yi = maty 'et respectant des 'C'onditions de passage sur d'autres points Q(xj,yj) 'Soit xj=matxc et yj=matyc 'Y = C1*X^n + Ci*X^(n-1) + ... + Cn. '!Attention! le degre n >= j-1 'PolyAC = "Poly"nome "A"pproché "C"onditionnel 'Traitement de l'index I = CLng(I) 'Résolution matricielle 'Tailles matrices Dim l As Long, L2 As Long, C As Long, C2 As Long l = MatX.Rows.Count L2 = MatY.Rows.Count C = MatX.Columns.Count C2 = MatY.Columns.Count Dim LC As Long, L2C As Long, CC As Long, C2C As Long LC = MatXC.Rows.Count L2C = MatYC.Rows.Count CC = MatXC.Columns.Count C2C = MatYC.Columns.Count 'Erreur de taille If C > 1 Or C2 > 1 Or CC > 1 Or C2C > 1 Then PolyAC = "#COLONNE!": Exit Function If l <> L2 Or LC <> L2C Then PolyAC = "#LIGNE!": Exit Function If LC > N + 1 Or l < N + 1 - LC Then PolyAC = "#DEGRE!": Exit Function If I - 1 > N Then PolyAC = "#INDICE!": Exit Function 'calcul la matrice rectangulaire en X ReDim coefa(1 To l, 1 To N + 1) Dim t As Long, tt As Long, X As Double For t = 1 To l X = MatX.Cells(t) For tt = 1 To N + 1 coefa(t, tt) = X ^ (N + 1 - tt) Next tt, t 'matrice Y ReDim coefb(l) For t = 1 To l coefb(t) = MatY.Cells(t) Next t 'Redéfinition matricelle carré selon 'la méthode des moindres carrés 'Matrice X avec reservation eq conditions ReDim MatA(1 To N + 1 + LC, 1 To N + 1 + LC) Dim m As Long, S As Double For tt = 1 To N + 1 For m = 1 To N + 1 S = 0 For t = 1 To l S = S + coefa(t, tt) * coefa(t, m) Next t MatA(tt, m) = S Next m, tt 'Redéfinition matricielle carré 'Matrice Y avec reservation eq conditions ReDim MatB(N + 1 + LC, 1) For tt = 1 To N + 1 S = 0 For t = 1 To l S = S + coefa(t, tt) * coefb(t) Next t MatB(tt, 1) = S Next tt 'Ajonction des eq conditions 'calcul la matrice carré en X 'eq complèments au système For tt = 1 To N + 1 For t = 1 To LC X = MatXC.Cells(t) MatA(tt, t + N + 1) = X ^ (N + 1 - tt) Next t, tt 'eq supplémentaires For t = 1 To LC X = MatXC.Cells(t) For tt = 1 To N + 1 MatA(t + N + 1, tt) = X ^ (N + 1 - tt) Next tt, t 'matrice Y For t = 1 To LC MatB(t + N + 1, 1) = MatYC.Cells(t) Next t 'inverse matA et garde la ligne i ReDim mataa(1, N + 1 + LC) For t = 1 To N + 1 + LC mataa(1, t) = InverseTabMat(MatA(), I, t) Next t 'produit deux lignes PolyAC = ProduitTabMat(mataa(), MatB(), 1, 1) End Function