bonsoir,
j'ai lancé le code mais il y a un débogage cette fois peut être ça dépend de la version excel comme il est montré ici :
et voilà ma fonction d'interpolation :
Public Function Interp2(xAxis As Range, yAxis As Range, zSurface As Range, xcoord As Double, ycoord As Double) As Double
' This function performs bilinear interpolation
Dim xArr() As Variant
xArr = xAxis.Value
Dim yArr() As Variant
yArr = yAxis.Value
Dim zArr() As Variant
zArr = zSurface.Value
'first find 4 neighbouring points
Dim nx As Long
Dim ny As Long
nx = UBound(xArr, 2)
ny = UBound(yArr, 1)
Dim lx As Single 'index of x coordinate of adjacent grid point to left of P
Dim ux As Single 'index of x coordinate of adjacent grid point to right of P
GetNeigbourIndices xArr, xcoord, lx, ux
Dim ly As Single 'index of y coordinate of adjacent grid point below P
Dim uy As Single 'index of y coordinate of adjacent grid point above P
GetNeigbourIndices yArr, ycoord, ly, uy
Dim fQ11, fQ21, fQ12, fQ22 As Double
fQ11 = zArr(lx, ly)
fQ21 = zArr(ux, ly)
fQ12 = zArr(lx, uy)
fQ22 = zArr(ux, uy)
'if point exactly found on a node do not interpolate
If ((lx = ux) And (ly = uy)) Then
Interp2 = fQ11
Exit Function
End If
Dim x, y, x1, x2, y1, y2 As Double
x = xcoord
y = ycoord
x1 = xArr(lx, 1)
x2 = xArr(ux, 1)
y1 = yArr(ly, 1)
y2 = yArr(uy, 1)
'if xcoord lies exactly on an xAxis node do linear interpolation
If (lx = ux) Then
Interp2 = fQ11 + (fQ12 - fQ11) * (y - y1) / (y2 - y1)
Exit Function
End If
'if ycoord lies exactly on an xAxis node do linear interpolation
If (ly = uy) Then
Interp2 = fQ11 + (fQ22 - fQ11) * (x - x1) / (x2 - x1)
Exit Function
End If
Dim fxy As Double
fxy = fQ11 * (x2 - x) * (y2 - y)
fxy = fxy + fQ21 * (x - x1) * (y2 - y)
fxy = fxy + fQ12 * (x2 - x) * (y - y1)
fxy = fxy + fQ22 * (x - x1) * (y - y1)
fxy = fxy / ((x2 - x1) * (y2 - y1))
Interp2 = fxy
End Function
Public Sub GetNeigbourIndices(inArr As Variant, x As Double, ByRef lowerX As Single, ByRef upperX As Single)
' It is required for the Iterp2 function
Dim n As Long
n = UBound(inArr, 1)
If n = 1 Then
'Transpose the arr
inArr = Application.Transpose(inArr)
n = UBound(inArr, 1)
End If
If x <= inArr(1, 1) Then
lowerX = 1
upperX = 1
ElseIf x >= inArr(n, 1) Then
lowerX = n
upperX = n
Else
Dim i As Long
For i = 2 To n
If x < inArr(i, 1) Then
lowerX = i - 1
upperX = i
Exit For
ElseIf x = inArr(i, 1) Then
lowerX = i
upperX = i
Exit For
End If
Next i
End If
End Sub
Donc le but c'est : appeller cette fonction sur la plage adéquate au nom de la table correspondante qui va être saisie par l'utilisateur ( par exemple la table que je vais saisir c'est V 30 donc ma macro va pointer sur la plage adéquate au nom de la table après il va appeller cette fonction Interp2(xAxis As Range, yAxis As Range, zSurface As Range, xcoord As Double, ycoord As Double).
Merci bcp pour ton aide
Cordialement
