Hej

Jag har skrivit ett makro för att beräkna temperaturen på en yta som funktion av isoleringstjockleken. Jag vill samla resultaten i två Arrays , en för längd-värdena och en för temperaturerna.
Jag gör beräkningarna för att antal tjocklekar på isoleringen med en FOR-loop. Inuti FOR-loopen använde jag en While-loop för att iterera fram temperaturerna. Det hela funkar bra så länge jag specificerar storleken på Array:erna i början av makrot.
Men jag vill istället få Array:erna att växa för varje temperaturberäkning. Från storleken/längden 1 i början till längden motsvarande antalet framräknande temperaturer och tillhörande isoleringstjocklekar. Jag vill inte ha några tomma ”celler” i Array:erna när beräkningarna är klara.

Jag använder ”i” and ”j” som index för Arrayerna. Och jag vill använda ”ReDim Preserve” till att ändra storleken på Arrayerna efter varje beräkning.


När jag i början skriver:
Dim MyArray() As Variant
Dim MyArray2() As Variant

får jag felet”Index ligger utanför intervallet” vid raden ”MyArray(i) = L”



När jag skriver:
Dim MyArray As Variant
Dim MyArray2 As Variant

får jag felmeddelandet ”Inkompatibla filtyper” vid raden ”MyArray(i) = L”



När jag skriver:
Dim MyArray(1 To 100) As Variant
Dim MyArray2(1 To 100) As Variant

fungerar det, men jag fåt ett antal tomma celler i Arrayen, beroende på hur många värden på isoleringstjockleken jag gör beräkningar för.


Nån som kan hjälpa mig lösa det här problemet?






----------------------------------------------------------------------------------------------

SÅ HÄR SER MAKROT UT!






Sub Makro1()


'This works
Dim MyArray(1 To 100) As Variant
Dim MyArray2(1 To 100) As Variant

'This DOESNT works
'Dim MyArray() As Variant
'Dim MyArray2() As Variant


'This DOESNT either works
'Dim MyArray As Variant
'Dim MyArray2 As Variant



Dim L As Variant
Dim Ts_ber As Variant

Dim i As Integer
Dim j As Integer
Dim x As Variant
Dim y As Variant
Dim z As Variant
Dim q As Variant

Ti = 278
Tomg = 298
W_fonster = 0.65
H_fonster = 1
k_polyst = 0.03
x = 0.001 'Minsta isoleringstjockleken
y = 0.1 'Största isoleringstjockleken
i = 1
j = 1




'------------HÄR BÖRJAR BERÄKNINGARNA/FOR-LOOPEN----------------

For L = x To y Step 0.001

Ts_giss1 = Ti + 10
T_film = (Ts_giss1 + Tomg) / 2
k_luft = -0.0000000343 * (T_film ^ 2) + 0.000098216 * T_film - 0.00014045
Pr = 0.0000005536157 * (T_film ^ 2) - 0.0005812727 * T_film + 0.8325763
konst = 0.68857 * (T_film ^ 4) - 992.85 * (T_film ^ 3) + 541960 * (T_film ^ 2) - 133470000 * T_film + 12628000000#
Gr = konst * (Tomg - Ts_giss1)
Nu = (0.825 + (0.387 * (Pr * Gr) ^ (1 / 6) / (1 + (0.492 / Pr) ^ (9 / 16)) ^ (8 / 27))) ^ 2
h = k_luft * Nu / H_fonster
Ts_ber = L / k_polyst * (h * (Tomg - Ts_giss1) + 0.6 * 0.00000005687 * (Ts_giss1 + Tomg) * (Ts_giss1 ^ 2 + Tomg ^ 2) * (Tomg - Ts_giss1)) + 278
deltaT_1 = Ts_ber - Ts_giss1
Diff = 100

Ts_giss2 = Tomg - 3





'---------HÄR BÖRJAR ITERATIONEN FÖR VARJE ISOLERINGSTJOCKLEK----------

While Abs(Diff) > 0.0001

T_film = (Ts_giss2 + Tomg) / 2
k_luft = -0.0000000343 * (T_film ^ 2) + 0.000098216 * T_film - 0.00014045
Pr = 0.0000005536157 * (T_film ^ 2) - 0.0005812727 * T_film + 0.8325763
konst = 0.68857 * (T_film ^ 4) - 992.85 * (T_film ^ 3) + 541960 * (T_film ^ 2) - 133470000 * T_film + 12628000000#
Gr = konst * (Tomg - Ts_giss2)
Nu = (0.825 + (0.387 * (Pr * Gr) ^ (1 / 6) / (1 + (0.492 / Pr) ^ (9 / 16)) ^ (8 / 27))) ^ 2
h = k_luft * Nu / H_fonster
Ts_ber = L / k_polyst * (h * (Tomg - Ts_giss2) + 0.6 * 0.00000005687 * (Ts_giss2 + Tomg) * (Ts_giss2 ^ 2 + Tomg ^ 2) * (Tomg - Ts_giss2)) + 278
deltaT_2 = Ts_ber - Ts_giss2
T_temp = Ts_giss2
Ts_giss2 = Ts_giss1 - deltaT_1 * (Ts_giss2 - Ts_giss1) / (deltaT_2 - deltaT_1)
Ts_giss1 = T_temp
Diff = Abs(deltaT_2 - deltaT_1)
deltaT_1 = deltaT_2

Wend

'-----------ITERATIONEN KLAR------------



'FÖRSÖKER HÄR SAMLA RESULTATEN I ARRAYERNA EFTER VARJE ITERATION
MyArray(i) = L
MyArray2(j) = Ts_ber
i = i + 1
j = j + 1



'ALTERNATIV 1. (VET INTE OM DET FUNKAR ÄN)
'ReDim Preserve MyArray(1 To i)
'ReDim Preserve MyArray2(1 To j)

'ALTERNATIVE 2. (VET INTE OM DET FUNKAR ÄN)
'ReDim Preserve MyArray(UBound(MyArray) + 1)
'ReDim Preserve MyArray2((UBound(MyArray2) + 1))




Next L


'----------BERÄKNINGARNA KLARA---------------







'---------------GÖR EN PLOT-------------------


If ActiveSheet.ChartObjects.Count > 0 Then
ActiveSheet.ChartObjects.Delete
End If

Dim shp As Shape
Dim cht As Chart
Dim srs As Series
Dim Yvals() As Variant

Set shp = ActiveSheet.Shapes.AddChart2(XlChartType:=xlLine)
Set cht = shp.Chart
Set srs = cht.SeriesCollection.NewSeries

cht.Parent.Name = "Chart 1"


With srs
.XValues = MyArray()
.Values = MyArray2()
End With


cht.AutoScaling = True
cht.ChartTitle.Text = "ts sfa L"
srs.Format.Line.Weight = 1.5




End Sub