11. Программа:

При написании программы я выбрала язык Visual Basic for Applications.

Attribute VB_Name = "MainMod"

Option Explicit

Dim b As Integer 'На этой строке заголовок

Dim i As Integer 'Переменная цикла

Dim Mesto As Single 'Начальное количество руды в месторождении

Dim OstSA As Single 'Остаток нераспроданного сырья А

Dim n As Integer 'Переменная конца цикла

Dim OgT As Single 'Ограничение на отходы

Dim Flag As Boolean 'Переменная "Флажок"

Sub Main_Module()

Range("A4:P65536").ClearContents ' Очищение листа

Call rogdenie

'Заполнение первой строки

i = 1

b = 3

Flag = False

With Columns("a:p")

.Cells(i + b, 1) = 0

.Cells(i + b, 2) = Mesto

.Cells(i + b, 3) = 0

.Cells(i + b, 4) = 4

.Cells(i + b, 5) = 0

.Cells(i + b, 6) = 0

.Cells(i + b, 7) = 0

.Cells(i + b, 8) = 0

.Cells(i + b, 9) = 5

.Cells(i + b, 10) = 10

.Cells(i + b, 11) = 0

.Cells(i + b, 12) = Mesto * 2 / 25

.Cells(i + b, 13) = Mesto * 2 / 100

.Cells(i + b, 14) = 0

.Cells(i + b, 15) = 0

.Cells(i + b, 16) = 0

End With

' Заполнение второй строки

Dim PP As Object

b = 3

n = 0

OstSA = 0

With Columns("a:p")

For i = 2 To 1000

.Cells(i + b, 1) = i - 1

If .Cells(i + b - 1, 12) * 100 / 60 >= Mesto / 10 Then ' спрос больше предложения

.Cells(i + b, 3) = Mesto / 10

If OstSA = 0 Then

.Cells(i + b, 5) = 0.6 * .Cells(i + b, 3)

Else

.Cells(i + b, 5) = 0.6 * .Cells(i + b, 3) + OstSA

OstSA = 0

End If

Call Tt

.Cells(i + b, 2) = .Cells(i - 1 + b, 2) - .Cells(i + b, 3)

Call Prises

Call SSA

Call SSB

Call Tv

Else ' спрос меньше предложения

If .Cells(i + b - 1, 12) * 100 / 60 >= Mesto / 80 Then

If .Cells(i + b - 1, 7) >= OgT Then

Flag = True

.Cells(i + b, 3) = Mesto / 80

.Cells(i + b, 5) = 0.6 * .Cells(i + b, 3)

Call Tt

.Cells(i + b, 2) = .Cells(i - 1 + b, 2) - .Cells(i + b, 3)

Call Prises

Call SSA

Call SSB

Call Tv

Else

If Flag = True Then

.Cells(i + b, 3) = Mesto / 80

.Cells(i + b, 5) = 0.6 * .Cells(i + b, 3)

Call Tt

.Cells(i + b, 2) = .Cells(i - 1 + b, 2) - .Cells(i + b, 3)

Call Prises

Call SSA

Call SSB

Call Tv

If Columns.Cells(i + b, 7) = 0 Then

Flag = False

Else

Flag = True

End If

Else

.Cells(i + b, 3) = .Cells(i + b - 1, 12) * 100 / 60

.Cells(i + b, 5) = 0.6 * .Cells(i + b, 3)

Call Tt

.Cells(i + b, 2) = .Cells(i - 1 + b, 2) - .Cells(i + b, 3)

Call Prises

Call SSA

Call SSB

Call Tv

End If

End If

Else

Call Pribil

MsgBox "Дальнейшая добыча руды не имеет смысла из-за неокупаемости проекта", , "Завершение расчетов"

End

End If

n = i

End If

Next i

End With

End Sub

Function SSA() As Single 'рассчитывает спрос на сырье А

Columns.Cells(i + b, 12) = 2 * Mesto / Columns.Cells(i + b, 9) ^ 2

End Function

Function SSB() As Single 'рассчитывает спрос на сырье В

Columns.Cells(i + b, 13) = 2 * Mesto / Columns.Cells(i + b, 10) ^ 2

End Function

FunctionTt()AsSingle' рассчитывает кол-во твердых отходов

Tt = Columns.Cells(i + b, 3) - Columns.Cells(i + b, 5)

Columns.Cells(i + b, 6) = Tt

End Function

FunctionPrises()AsSingle' рассчитывает цену на сырье А и В

Columns.Cells(i + b, 11) = Columns.Cells(i + b - 1, 2) / Columns.Cells(i + b, 2)

Columns.Cells(i + b, 4) = Columns.Cells(i + b - 1, 4) * Columns.Cells(i + b, 11)

Columns.Cells(i + b, 9) = Columns.Cells(i + b, 4) + 1

Columns.Cells(i + b, 10) = Columns.Cells(i + b, 4) + 6

End Function

FunctionTv() 'кол-во сырья В

Dim RazSB As Single ' разница между спросом на сырье В и его предложением

Dim RazSA As Single ' разница между спросом на сырье А и его предложением

Columns.Cells(i + b, 8) = Columns.Cells(i + b, 6) * 0.55

If Columns.Cells(i + b, 8) >= Columns.Cells(i + b, 13) Then 'предложение В больше спроса В

If Columns.Cells(i + b, 5) <= Columns.Cells(i + b, 12) Then 'предложение А меньше спроса А

Columns.Cells(i + b, 7) = Columns.Cells(i + b - 1, 7) +(Columns.Cells(i + b, 8) - Columns.Cells(i + b, 13)) * 100 / 55

Columns.Cells(i + b, 16) = Columns.Cells(i + b, 13) '8

RazSB = Columns.Cells(i + b, 8) - Columns.Cells(i + b, 13)

RazSA = Columns.Cells(i + b, 12) - Columns.Cells(i + b, 5)

If RazSA >= RazSB Then

Columns.Cells(i + b, 15) = Columns.Cells(i + b, 5) + RazSB

Else

Columns.Cells(i + b, 15) = Columns.Cells(i + b, 5) + RazSA

Columns.Cells(i + b, 7) = Columns.Cells(i + b, 7) - RazSA * 100 / 55

End If

Else ' предложение А больше спроса А

Columns.Cells(i + b, 15) = Columns.Cells(i + b, 12)

RazSA = Columns.Cells(i + b, 5) - Columns.Cells(i + b, 12)

OstSA = OstSA + RazSA

Columns.Cells(i + b, 7) = Columns.Cells(i + b - 1, 7) +(Columns.Cells(i + b, 8) - Columns.Cells(i + b, 13)) * 100 / 55

Columns.Cells(i + b, 16) = Columns.Cells(i + b, 13) '8

End If

Else ' предложение В меньше спроса В

If Columns.Cells(i + b, 5) <= Columns.Cells(i + b, 12) Then 'предложение А меньше спроса А

If Columns.Cells(i + b - 1, 7) = 0 Then ' отходов нет

Columns.Cells(i + b, 16) = Columns.Cells(i + b, 8) '16 и 8

Columns.Cells(i + b, 7) = 0

Columns.Cells(i + b, 15) = Columns.Cells(i + b, 5) '16 и 8

Else ' отходы есть

RazSB = (Columns.Cells(i + b, 13) - Columns.Cells(i + b, 8)) * 100 / 55

If RazSB <= Columns.Cells(i + b - 1, 7) Then 'недостающее кол-во сырья В меньше чем остаток отходов

Columns.Cells(i + b, 16) = Columns.Cells(i + b, 8) + RazSB * 0.55 ' 8

Columns.Cells(i + b, 7) = Columns.Cells(i + b - 1, 7) - RazSB

RazSA = Columns.Cells(i + b, 12) - Columns.Cells(i + b, 5)

If OstSA < RazSA Then

Columns.Cells(i + b, 15) = Columns.Cells(i + b, 5) + OstSA

OstSA = 0

Else

Columns.Cells(i + b, 15) = Columns.Cells(i + b, 12)

OstSA = OstSA - RazSA

End If

Else 'недостающее кол-во сырья В больше чем остаток отходов

Columns.Cells(i + b, 16) = Columns.Cells(i + b, 8) + Columns.Cells(i + b - 1, 7) * 0.55 '8

Columns.Cells(i + b, 7) = 0

Columns.Cells(i + b, 15) = Columns.Cells(i + b, 5) + OstSA

End If

End If

Else ' предложение А больше спроса А

RazSA = Columns.Cells(i + b, 5) - Columns.Cells(i + b, 12)

RazSB = (Columns.Cells(i + b, 13) - Columns.Cells(i + b, 8)) * 55 / 100

If Columns.Cells(i + b - 1, 7) = 0 Then 'остатков отходов нет

If RazSB * 0.55 >= RazSA Then ' сырья В нужно больше, чем можно взять из сырья А

Columns.Cells(i + b, 16) = Columns.Cells(i + b, 8) + RazSA '8

Columns.Cells(i + b, 15) = Columns.Cells(i + b, 12) '12

Columns.Cells(i + b, 7) = 0

Else 'сырья В нужно меньше, чем можно взять из сырья А

Columns.Cells(i + b, 16) = Columns.Cells(i + b, 13) '8

Columns.Cells(i + b, 5) = Columns.Cells(i + b, 5) - RazSB

Columns.Cells(i + b, 15) = Columns.Cells(i + b, 12) '15

OstSA = Columns.Cells(i + b, 5) - Columns.Cells(i + b, 12)

Columns.Cells(i + b, 7) = 0

End If

Else ' остатки отходов есть

If RazSB * 0.55 >= RazSA Then ' сырья В нужно больше, чем можно взять из сырья А

Columns.Cells(i + b, 16) = Columns.Cells(i + b, 8) + RazSA '8

Columns.Cells(i + b, 15) = Columns.Cells(i + b, 12) '15

RazSB = (Columns.Cells(i + b, 13) - Columns.Cells(i + b, 16)) * 55 / 100

If RazSB <= Columns.Cells(i + b - 1, 7) Then ' если сырье В можно взять из оставшихся отходов

Columns.Cells(i + b, 16) = Columns.Cells(i + b, 13) '8

Columns.Cells(i + b, 7) = Columns.Cells(i + b - 1, 7) - RazSB

Else ' если сырье В можно взять из оставшихся отходов, но этого будет недостаточно

Columns.Cells(i + b, 16) = Columns.Cells(i + b, 8) + Columns.Cells(i + b - 1, 7) * 0.55

End If

Else ' сырья В нужно меньше, чем можно взять из сырья А

Columns.Cells(i + b, 7) = Columns.Cells(i + b - 1, 7)

Columns.Cells(i + b, 16) = Columns.Cells(i + b, 13) '8

Columns.Cells(i + b, 5) = Columns.Cells(i + b, 5) - RazSB

Columns.Cells(i + b, 15) = Columns.Cells(i + b, 12) '15

OstSA = Columns.Cells(i + b, 5) - Columns.Cells(i + b, 12)

End If

End If

End If

End If

End Function

Function Pribil()

For i = 1 To n

With Columns("a:p")

.Cells(i + b, 14) = .Cells(i + b, 15) * .Cells(i + b, 9) + .Cells(i + b, 16) * .Cells(i + b, 10)

End With

Next

End Function

Sub rogdenie()

Dim MR As String, YN As Boolean

Const BoxTitle = "Месторождение:"

YN = False

Do Until YN

MR = InputBox("Введите кол-во полезных ископаемых в месторождении в тыс. тонн (100-1000000), десятичные - через запятую")

Mesto = CSng(MR)

If Mesto < 100 Or Mesto > 1000000 Then

MsgBox "Неправильно указано колличество! Попробуй еще!", , "Ошибка!"

YN = False

Else

YN = True

End If

Loop

OgT = Mesto / 30

End Sub