26. februar 2002 - 18:04Der 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)
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.
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
