26. februar 2002 - 18:04
Der er
2 kommentarer og
1 løsning
Interpolation i VB Excel
Hej
Jeg er ikke den helt store ørn til at programmere i VB, derfor denne forespørgsel.
Jeg har brug for en funktion i excel der ikke er der i forvejen. Jeg har nu forgæves forsøgt at programmere mig ud af det i VB i et par timer, en må kaste håndklædet i ringen.
Jeg har brug for en funktion, der tager en range "XY" og en double "X" som input og returnerer en double "Y".
Rangen har 2 kolonner og et vilkårlig antal rækker (indenfor rimelighedens grænser :)". Ud fra kolonne 1 i XY skal det rigtige interval findes og der skal interpoleres en Y værdi som resultat.
Det her er egentlig en meget simpel ting, men mine evner har ikke kunnet række :/.
Problemet kan også beskrives på en anden måde: man har en lang række X+Y punkter der danner en kurve og derudfra beregnes en interpoleret Y værdi ud fra en given X værdi.
Jeg håber der er en eller anden der kan bruge 3 minutter på mit problem. Det skal helst være en funktion jeg kan bruge på lige fod med alle de andre funktioner der er i excel.
Tak
Justin Case
P.S. 60 point fordi opgaven nok kræver en smule fodarbejde. Ikke fordi den er svær (for den rutinerede)
26. februar 2002 - 18:05
#1
Jeg bruger iøvrigt Excel97, men jeg kan ikke forestille mig, at andre versioner er meget anderledes
26. februar 2002 - 18:14
#2
Function garCurveInterpol(ByVal arInput As Variant, ByVal ldblXval As Double) As Double
Dim larInput As Variant
Dim lbolFound As Boolean
Dim lintElement As Integer
Dim lintUbound As Integer
Dim ldblFrac As Double
Dim lintX As Integer
'convert possible rangeobject to array
larInput = arInput
'todo: sort larinput
If ldblXval <= larInput(LBound(larInput, 1), LBound(larInput, 2)) Then
garCurveInterpol = larInput(LBound(larInput, 1), UBound(larInput, 2)) ' x < lower bound
ElseIf ldblXval >= larInput(UBound(larInput, 1), LBound(larInput, 2)) Then
garCurveInterpol = larInput(UBound(larInput, 1), UBound(larInput, 2)) ' x > upper bound
Else
'first find max(elm) <= x
lbolFound = False
lintX = LBound(larInput, 1)
While Not lbolFound
If larInput(lintX, 1) <= ldblXval And larInput(lintX + 1, 1) >= ldblXval Then
lbolFound = True
Else
lintX = lintX + 1
End If
Wend
ldblFrac = (ldblXval - larInput(lintX, 1)) / (larInput(lintX + 1, 1) - larInput(lintX, 1))
garCurveInterpol = (1 - ldblFrac) * larInput(lintX, 2) + ldblFrac * larInput(lintX + 1, 2)
End If
End Function
Bemærk at den forudsætter at tidsrækkerne er sorteret efter første kolonne.
/Jennemaan
