Global x(), f()

Sub Макрос1()
'
' Макрос1 Макрос

Dim x0(), x(), k1(), k2(), k3(), k4(), k5(), f() As Variant
n = 2 'число уравнений
t0 = 0
tk = Cells(5, 1)
m = Cells(5, 4)
ReDim x0(n), x(n), k1(n), k2(n), k3(n), k4(n), k5(n), f(n)
h = (tk - t0) / m 'шаг
x0(1) = Cells(5, 2)
x0(2) = Cells(5, 3)

If r <= e Then
If r >= e / 30 Then

For i = 1 To m
For j = 1 To n
x(j) = x0(j)
Next j
subrout x, f
For j = 1 To n
k1(j) = f(j) * h
x(j) = x0(j) + k1(j) / 2
Next j
subrout x, f
For j = 1 To n
k2(j) = f(j) * h
x(j) = x0(j) + k2(j) / 3
Next j
subrout x, f
For j = 1 To n
k3(j) = f(j) * h
x(j) = x0(j) + k3(j) / 3
Next j
subrout x, f
For j = 1 To n
k4(j) = f(j) * h
x(j) = x0(j) + k4(j) / 5
Next j
subrout x, f
For j = 1 To n
k5(j) = f(j) * h
x0(j) = x0(j) + (k1(j) + 4 * k4(j) + k5(j)) / 6
r = (-2 * k1(j) + 9 * k3(j) - 8 * k4(j) + k5(j)) / 30
Next j

If r > e Then
If (r >= e / 30) Then
h = (tk - t0) / 2
Else
If r <= e Then
If r < e / 30 Then
h = (tk - t0) * 2
End If
Next

Cells(10 + i, 1) = t0 + i * h
Cells(10 + i, 2) = x0(1)
Cells(10 + i, 3) = x0(2)
Cells(10 + i, 4) = r
Next i

'
End Sub

Sub subrout(x, f) 'Подпрограмма-функция
w = Exp(22.387 - 7455 / (x(2) + 273)) * x(1)
f(1) = (1.16 - x(1)) / 10 - w
f(2) = (20 - x(2)) / 10 + 123000000# * w / 2500 / 1600
End Sub