16. august 2011 - 10:00
Der er
5 kommentarer og
1 løsning
linier interpolation (skriv i felter)
Hej Eksperter
Jeg er ved at lave et større regneark, hvor jeg sidder fast omkring følgende:
Jeg ønsker at kunne vælge to X-værdier og to Y-værdier, begge i intervallet 100, 200, 300, ... 50000, men uafhængige af hinanden.
eks. X1=200, Y1=300, X2=2600, Y2=30000.
Her af beregner jeg den største forskel, hvilket er på Y: 30000-300=27000
27000/100=270 (spring på 100) skal nu være grundlaget for antallet af linjer interpolations værdier, der skal beregnes på de tilhørende X-værdier.
Mit spørgsmål er nu:
Hvordan får jeg excel til automatisk at oprette felter til hver af værdierne mellem Y1 og Y2, så jeg til slut har en lille tabel med Y-værdierne 300, 400, 500, ...28000, 29000, 30000 og tilhørende interpolerede X-værdier?
Beregningen er ikke problemet, men den automatiske tildeling af Y-værdier til felterne.
Håber at mit spørgsmål er forståeligt og naturligvis at der er nogen der vil hjælpe.
16. august 2011 - 16:36
#1
Prøv med denne kode:
Koden er baseret på at
B1 indeholder Minimum Y værdi
B2 indeholder Maximum Y værdi
Værdier bliver indsat fra A4 og nedefter i én kolonne.
Du kan evt. selv rette til, hvis du vil have dataopbygningen anderledes.
Tryk Alt+F11 for at åbne Visual Basic Editor
tryk Ctrl+R, hvis du ikke kan se listen over dine ark
Højreklik på et arknavn i venstre pane
Indsæt modul
Kopier nedenstående ind i modulet
Kør koden ved at trykke F11 (Husk at gemme inden, så du ikke ødelægger noget) eller via funktioner/Makroer i Excel 2003 eller Makroer fra fanebladet "Vis" i Excel 2007/2010.
Option Explicit
Sub OpretY_Liste()
Dim y1 As Long, y2 As Long
Dim Raekke As Long, Kolonne As Long
Dim Val() As Long, v As Long, interval As Integer
Dim Val2() As Long
' Y1 = Min, Y2 = Max
y1 = Range("b1").Value
y2 = Range("b2").Value
' Indsæt y-værdier i kolonne A startende i række 4
ReDim Val(1 To 1, 1 To y2) As Long
Do
If v = 0 Then
v = LBound(Val, 2)
Val(1, v) = y1
Else
Select Case Len(CStr(Val(1, v - 1)))
Case 3
interval = 100
Case 4
interval = 1000
Case 5
interval = 1000
End Select
Val(1, v) = Val(1, v - 1) + interval
End If
If Val(1, v) = y2 Then
Exit Do
End If
v = v + 1
Loop
ReDim Preserve Val(LBound(Val, 1) To UBound(Val, 1), LBound(Val, 2) To v) As Long
' Vend Array for at kunne indlæse arrayet i Excel
ReDim Val2(LBound(Val, 2) To UBound(Val, 2), LBound(Val, 1) To UBound(Val, 1)) As Long
For Raekke = LBound(Val, 2) To UBound(Val, 2) Step 1
For Kolonne = LBound(Val, 1) To UBound(Val, 1) Step 1
Val2(Raekke, Kolonne) = Val(Kolonne, Raekke)
Next Kolonne
Next Raekke
' Indsæt værdier
Raekke = 4
Kolonne = 1
Range(Cells(Raekke, Kolonne), Cells(Raekke + UBound(Val2, 1) - 1, Kolonne + UBound(Val2, 2) - 1)) = Val2()
End Sub
17. august 2011 - 10:32
#3
Det glæder mig, at du kunne bruge det, men det ville være høfligt at tildele pointene til den, der svarer istedet for sig selv :-).
Nå, men det er ikke så vigtigt, men du må hellere huske det til næste gang. Nogen er mere obs på point end andre :-)
