Sub Тонколистовая_прокатка()
'объявление переменных
Dim i As Integer 'номер сечения
Dim ii As Integer 'номер нейтрального сечения
Dim n As Integer 'число разбиений очага деформации
Dim h0 As Double 'начальная толщина листа
Dim hn As Double 'конечная толщина листа
Dim h() As Double 'толщина листа в i-том сечении (массив)
Dim St0 As Double 'начальный предел текучести
Dim Stn As Double 'конечный предел текучести
Dim St() As Double 'предел текучести в i-том сечении (массив)
Dim q0 As Double 'уровень заднего натяжения
Dim qn As Double 'уровень переднего натяжения
Dim R As Double 'радиус рабочего валка
Dim a As Double 'коэффициент упрочнения
Dim b As Double 'коэффициент упрочнения
Dim alfa As Double 'угол захвата
Dim fi() As Double 'угол fi (массив)
Dim dx() As Double  'dx (массив)
Dim P1() As Double 'нормальные напряжения в зоне отставания
Dim P2() As Double 'нормальные напряжения в зоне опережения
Dim P() As Double 'напряжения для двух зон очага деформации
Dim PP As Double 'сумма нормальных напряжений
Dim PPP As Double 'полное усилие прокатки
Dim K0 As Double 'предел текучести на сдвиг начальный
Dim Kn As Double 'предел текучести на сдвиг конечный
Dim K() As Double 'предел текучести на сдвиг в i-том сечении
Dim m As Double 'коэффициент трения
Dim W As Double 'ширина листа

'присвоение переменным числовых значений из ячеек листа Excel
h0 = Range("D3").Value 'значение начальной толщины листа
hn = Range("D4").Value 'значение конечной толщины листа
W = Range("D5").Value 'значение ширины листа
St0 = Range("D6").Value 'значение начального предела текучести
q0 = Range("D7").Value 'значение уровня заднего натяжения
qn = Range("D8").Value 'значение уровня переднего натяжения
m = Range("D9").Value 'значение коэффициента трения
a = Range("D10").Value 'значение коэффициента упрочнения a
b = Range("D11").Value 'значение коэффициента упрочнения b
R = Range("D12").Value 'значение радиуса рабочего валка
n = Range("D13").Value 'число разбиений очага деформации

'объявление массива
ReDim fi(0 To n) As Double
ReDim h(0 To n) As Double
ReDim dx(0 To n) As Double
ReDim St(0 To n) As Double
ReDim K(0 To n) As Double
ReDim P1(0 To n) As Double
ReDim P2(0 To n) As Double
ReDim P(0 To n) As Double

Stn = St0 + a * ((h0 - hn) / h0) ^ b 'формула(22)
Kn = Stn / Sqr(3) 'формула(21)
K0 = St0 / Sqr(3) 'формула(19)
alfa = 2 * Atn(Sqr((h0 - hn) / (4 * R - (h0 - hn)))) 'формула (8)

i = 1 'расчет для зоны отставания от i=1 до i=n
1: fi(i) = alfa * (n - i) / n 'формула(7)
   h(i) = hn + 2 * R * (1 - Cos(fi(i))) 'формула(6)
   fi(0) = alfa
   dx(i) = R * (Sin(fi(i - 1)) - Sin(fi(i))) 'формула(5)
   St(i) = St0 + a * ((h0 - h(i)) / h0) ^ b 'формула(12)
   K(i) = St(i) / Sqr(3) 'формула(11)
   P1(0) = 2 * K0 - q0 * St0 'формула (18)
   h(0) = h(0)
   K(0) = K(0)
   P1(i) = (P1(i - 1) * h(i - 1) - 2 * K(i - 1) * h(i - 1) + 2 * K(i) * h(i)) / (h(i) + 2 * dx(i) * Tan(fi(i)) - 2 * m * dx(i)) 'формула(14)
   If m * P1(i) <= K(i) Then
   P1(i) = P1(i)
   Else
   P1(i) = (P1(i - 1) * h(i - 1) - 2 * K(i - 1) * h(i - 1) + 2 * K(i) * h(i)) / (h(i) + 2 * dx(i) * Tan(fi(i))) 'формула (15)
   End If
   If i < n Then
   i = i + 1
   GoTo 1
   End If
   i = n - 1 'расчет для зоны опережения от i=n-1 до i=ii
2: fi(n) = 0
   fi(i) = alfa * (n - i) / n 'формула(7)
   h(i) = hn + 2 * R * (1 - Cos(fi(i))) 'формула(6)
   dx(i) = R * (Sin(fi(i)) - Sin(fi(i + 1))) 'формула(5)
   St(i) = St0 + a * ((h0 - h(i)) / h0) ^ b 'формула(12) <------ [color=red]ПИШЕТ ЧТО ТУТ ОШИБКА[/color]  
   St(n) = Stn
   K(i) = St(i) / Sqr(3) 'формула(11)
   P2(n) = 2 * Kn - qn * Stn 'формула(20)
   h(n) = hn
   K(n) = Kn
   dx(n) = 0
   P2(i) = (P2(i + 1) * (h(i + 1) + 2 * dx(i + 1) * Tan(fi(i + 1)) + 2 * m * dx(i + 1)) + 2 * K(i) + h(i) - 2 * K(i + 1) * h(i + 1)) / h(i) 'формула(16)
   If m * P2(i) <= K(i) Then
   P2(i) = P2(i)
   Else
   P2(i) = (P2(i + 1) * (h(i + 1) + 2 * dx(i + 1) * Tan(fi(i + 1)) + 2 * K(i) * h(i) - 2 * K(i + 1) * (h(i + 1) - dx(i + 1)))) / h(i) 'формула(17)
   End If
   If P1(i) - P2(i) <= 0 Then
   ii = i
   Else
   i = i - 1
   GoTo 2
   End If
   
   PP = 0
   For i = o To n
   If i < ii Then
   P(i) = P1(i)
   Else
   P(i) = P2(i)
   End If
   PP = PP + P(i)
   Next i
   PPP = PP * W * alfa * R / n * 10 / 1000000 'полное усидие в МН
   
   'вывод результатов расчета на лист Excel
   For i = 0 To n
   Cells(3 + i, 7).Value = i
   Cells(3 + i, 8).Value = Sqr(R * (h0 - hn)) * i / n 'длина очага деформации
   Cells(3 + i, 9).Value = P(i) 'контактные нормальные напряжения
   Next i
   Cells(3, 11).Value = PPP 'полное усилие
End Sub