Реферат: Решение экономических задач с помощью VBA

Пусть Xj – кол-во стандартных рулонов, разрезанных по варианту j, где j[1..19]. Ограничения налагаемые на переменные Xj связаны с требованием обеспечить изготовление заказанного кол-ва нестандартных рулонов. Ф-ция цели учитывает суммарные отходы, получаемые при выполнении заказа. Таким образом имеем следующую мат. модель:

Минимизировать:

Z=x1+2x3+x4+2x5+x7+3x8+2x11+2x12+2x13+x14+x15+3x16+

+2x18 + 4(x5+x6+x7+x8+x9+2x10+2x11+2x12+2x13+3x14+4x15+4x16+4x17+5ч18+7x19-220)+ 6(...-210)+9(...-350)+

+11(...-380)

    Отведем диапазон ячеек (i4:i22) под переменные . Введем в диапазон ячеек (j3:m3) левые части ограничений, определенные слежующими формулами:

         =СУММПРОИЗВ($I$4:$I$22;B4:B22)

=СУММПРОИЗВ($I$4:$I$22;c4:c22)

=СУММПРОИЗВ($I$4:$I$22;d4:d22)

    =СУММПРОИЗВ($I$4:$I$22;e4:e22)

В ячейку N4 введем ф-цию цели:

=СУММПРОИЗВ($I$4:$I$22;F4:F22)+B3*(СУММПРОИЗВ($I$4:$I$22;B4:B22)-J3)+C3*(СУММПРОИЗВ($I$4:$I$22;C4:C22)-K3)+D3*(СУММПРОИЗВ($I$4:$I$22;D4:D22)-L3)+E3*(СУММПРОИЗВ($I$4:$I$22;E4:E22)-M3)

где в ячейки B3:E3 введены длины, а в ячейки J3:M3 – кол-ва заказанных рулонов

     Выберем команду сервис – Поиск решения и заполним открывшееся диалоговое окно Поиск решения (Solver):

- Установим целевую ячейку – N4

- Изменяя ячейки I4:I22

- Ограничения $I$4:$I$22=целое

              $I$4:$I$22>=0

                 $j$4:$m$4>=$j$3:$m$3    

   - Ф-ция = минимизация

2.3.7 База данных

    Создадим поля базы данных, и занесем их в таблицу. База данных будет заполняться программой, программе не требуются названия полей, но для облегчения ориентации в первой строке введем данные соответствующие полям БД

   Создадим кнопку “Добавление”  для добавления записей в БД, делается это так: Вызываем панель инструментов на которой расположены примитивы, т.е. окна ввода, кнопки и т.д. Создаем на форме кнопку, и спомощью св-ва Caption присваиваем ей название “Добавление”

    Создадим макрос который будет отвечать за обработку событий по нажатию этой кнопки. Перейдем в среду Visual Basic for Application и в меню «Вставка» выберем UserForm, на эту форму и поместим все обьекты оговоренные в условии(m раскрывающихся списков, n полей ввода, ...).

     В макросе отвечающем за событие кнопки «Добавление» введем процедуру которая будет активизировать форму UserForm1, и заносить все данные из окна ввода в ячейки листа A4:L4, A5:L5 и т.д.

  По нажатию кнопки “OK” выполнится следующий код программы:

 Окно ввода выглядит следующим образом:

СПИСОК ИСПОЛЬЗОВАННЫХ ИСТОЧНИКОВ

  1.  А.Гарнаев. Использование MS Excel и VBA в экономике и финансах

  2. С. Браун, Visual Basic 5.0 с самого начала, Москва 1999, издательство “Питер” 

  3.  Microsoft Visual Basic – on-Line HELP

ПРИЛОЖЕНИЕ 1

    ПРОГРАММА НА ЯЗЫКЕ MICROSOFT VISUAL BASIC

Модуль 1:

Sub Return_To_MainMenu()

 Worksheets("Содержание").Activate

End Sub

Модуль 2:

Sub Task1()

 Worksheets("Задание1").Activate

End Sub

Sub Task2()

 Worksheets("Задание2").Activate

End Sub

Sub Task3()

  Worksheets("Задание3").Activate

End Sub

Sub Task4()

 Worksheets("Задание4").Activate

End Sub

Sub Task1_Evrica()

 Dim mas1(3) As Integer

 Dim mas2(3) As Integer

 Dim Mas_I1(3) As Integer

 B = Worksheets("Задание1").Range("B11").Value

 c = Worksheets("Задание1").Range("C11").Value

 D = Worksheets("Задание1").Range("D11").Value

 mas1(1) = B

 mas1(2) = c

 mas1(3) = D

 i = 1

 l = 0

 Do

    k = mas1(i)

    ''''' Занесение в массив Mas2 эл-тов >1490

    If k > 1490 Then mas2(i) = mas1(i) Else mas2(i) = 0

    i = i + 1

 Loop Until i = 4

 Max = -1

 i = 0

 Do

       i = i + 1

       If mas2(i) > Max Then

        Max = mas2(i)

        indm = i

       End If

 Loop Until i = 3

 Worksheets("Задание1").Cells(12, indm + 1).Value = Max * 0.02 + Max * 0.04

 'Worksheets("Задание1").Range("f15").Value = r

                   'GoTo l

 ''''' Находим MAx эл-т из оставшихся,

 ''''' и запоминаем его индеск

 Max = -1

 i = 0

 Do

       i = i + 1

       If i <> indm And mas2(i) > Max Then

          Max = mas2(i)

          indm2 = i

       End If

 Loop Until i = 3

 Worksheets("Задание1").Cells(12, indm2 + 1).Value = Max * 0.02 + Max * 0.02

 ''''' Находим MAx эл-т из оставшихся,

 ''''' и запоминаем его индеск

 Max = -1

 i = 0

 Do

       i = i + 1

       If mas2(i) > Max And i <> indm2 And i <> indm Then

       Max = mas2(i)

       indm3 = i

       End If

 Loop Until i = 3

 Worksheets("Задание1").Cells(12, indm3 + 1).Value = Max * 0.02 + Max * 0.01

 End Sub

Sub Task2_Evrica()

Dim AA_1(3) As Integer

B = Worksheets("Задание2").Range("B11").Value

c = Worksheets("Задание2").Range("C11").Value

D = Worksheets("Задание2").Range("D11").Value

AA_1(1) = B

AA_1(2) = c

AA_1(3) = D

i = 0

Do

 i = i + 1

 If AA_1(i) < 700 Then Worksheets("Задание2").Cells(12, i + 1).Value = Worksheets("Задание2").Cells(11, i + 1).Value * 0.01

 If AA_1(i) >= 700 And AA_1(i) < 1400 Then Worksheets("Задание2").Cells(12, i + 1).Value = Worksheets("Задание2").Cells(11, i + 1).Value * 0.015

 If AA_1(i) >= 1400 And AA_1(i) < 2800 Then Worksheets("Задание2").Cells(12, i + 1).Value = Worksheets("Задание2").Cells(11, i + 1).Value * 0.023

 If AA_1(i) >= 2800 Then Worksheets("Задание2").Cells(12, i + 1).Value = Worksheets("Задание2").Cells(11, i + 1).Value * 0.025

Loop Until i = 3

End Sub

Sub Task3_Evrica()

 Dim AA_2(10) As Integer

 Dim MM_1(10) As Integer

 Dim MM_2(10) As Integer

 Dim MM_3(10) As Integer

 Dim MM_4(10) As Integer

 Dim MM_5(10) As Integer

Worksheets("Задание3").Range("I3:I12").Clear

Worksheets("Задание3").Range("b3:h12").Font.Bold = False

Worksheets("Задание3").Range("b3:h12").Font.Size = 10

Worksheets("Задание3").Range("b3:h12").Font.Italic = False

i = 0

Do

 i = i + 1

 AA_2(i) = Worksheets("Задание3").Cells(i + 2, 7).Value

Loop Until i = 9

Max = -1

i = 0

Do

i = i + 1

If AA_2(i) > Max Then

Max = AA_2(i)

mm = i

End If

Loop Until i = 9

Worksheets("Задание3").Cells(mm + 2, 8).Value = "Макс. Цена на товар"

Min = 100000

i = 0

Do

i = i + 1

If AA_2(i) < Min Then

Min = AA_2(i)

mm2 = i

End If

Loop Until i = 9

Worksheets("Задание3").Cells(mm2 + 2, 8).Value = "Миним. Цена на товар"

'''''''''''''''''''''''''''''

i = 0

Do

 i = i + 1

 MM_1(i) = Worksheets("Задание3").Cells(i + 2, 2).Value

 MM_2(i) = Worksheets("Задание3").Cells(i + 2, 3).Value

 MM_3(i) = Worksheets("Задание3").Cells(i + 2, 4).Value

 MM_4(i) = Worksheets("Задание3").Cells(i + 2, 5).Value

 MM_5(i) = Worksheets("Задание3").Cells(i + 2, 6).Value

Loop Until i = 9

'''' 1

Min = 100000

i = 0

Do

i = i + 1

If MM_1(i) < Min Then

Min = MM_1(i)

x1 = i

End If

Loop Until i = 9

Worksheets("Задание3").Cells(x1 + 2, 2).Font.Bold = True

Worksheets("Задание3").Cells(x1 + 2, 2).Font.Size = 11

Worksheets("Задание3").Cells(x1 + 2, 2).Font.Italic = True

'''' 2

Min = 100000

i = 0

Do

i = i + 1

If MM_2(i) < Min Then

Min = MM_2(i)

x2 = i

End If

Loop Until i = 9

Worksheets("Задание3").Cells(x2 + 2, 3).Font.Bold = True

Worksheets("Задание3").Cells(x2 + 2, 3).Font.Size = 11

Worksheets("Задание3").Cells(x2 + 2, 3).Font.Italic = True

'''' 3

Min = 100000

i = 0

Do

i = i + 1

If MM_3(i) < Min Then

Min = MM_3(i)

x3 = i

End If

Loop Until i = 9

Worksheets("Задание3").Cells(x3 + 2, 4).Font.Bold = True

Worksheets("Задание3").Cells(x3 + 2, 4).Font.Size = 11

Worksheets("Задание3").Cells(x3 + 2, 4).Font.Italic = True

'''' 4

Min = 100000

i = 0

Do

i = i + 1

If MM_4(i) < Min Then

Min = MM_4(i)

x4 = i

End If

Loop Until i = 9

Worksheets("Задание3").Cells(x4 + 2, 5).Font.Bold = True

Worksheets("Задание3").Cells(x4 + 2, 5).Font.Size = 11

Worksheets("Задание3").Cells(x4 + 2, 5).Font.Italic = True

'''' 5

Min = 100000

i = 0

Do

i = i + 1

If MM_5(i) < Min Then

Min = MM_5(i)

x5 = i

End If

Loop Until i = 9

Worksheets("Задание3").Cells(x5 + 2, 6).Font.Bold = True

Worksheets("Задание3").Cells(x5 + 2, 6).Font.Size = 11

Worksheets("Задание3").Cells(x5 + 2, 6).Font.Italic = True

'''' 6

End Sub

Sub Task5()

 Worksheets("Задание5").Activate

End Sub

Sub Task6()

 Worksheets("Задание5").Activate

End Sub

Sub Task5_Evrica()

 Dim G(4, 4)

 Dim c(4)

c(1) = Worksheets("Задание5").Range("a1")

c(2) = Worksheets("Задание5").Range("b1")

c(3) = Worksheets("Задание5").Range("c1")

c(4) = Worksheets("Задание5").Range("d1")

Worksheets("Задание5").Range("a3:d6").Value = ""

For i = 1 To 4

For j = 1 To 4

 If i <= j + 1 Then G(i, j) = c(i) * (Cos(c(j))) ^ 2

 If i > j + 1 Then G(i, j) = Abs(c(i - j) ^ 3 - c(i))

Next

Next

For i = 1 To 4

For j = 1 To 4

Worksheets("Задание5").Cells(i + 2, j).Value = G(i, j)

Next

Next

End Sub

Sub Task6_Evrica()

 Dim X(4)

 Dim Y(4)

X(1) = Worksheets("Задание5").Range("a12")

X(2) = Worksheets("Задание5").Range("a13")

X(3) = Worksheets("Задание5").Range("a14")

X(4) = Worksheets("Задание5").Range("a15")

Y(1) = Worksheets("Задание5").Range("b12")

Y(2) = Worksheets("Задание5").Range("b13")

Y(3) = Worksheets("Задание5").Range("b14")

Y(4) = Worksheets("Задание5").Range("b15")

s1 = 0

s2 = 0

s3 = 0

m = 4

For i = 1 To m

s1 = s1 + X(i)

s2 = s2 + X(i) * Y(i)

s3 = s3 + X(i) * X(i)

Next

s = (2 * s1 + s2) * (2 - s1) + 3 + s3

Worksheets("Задание5").Range("D15").Value = s

End Sub

Sub Task7()

Worksheets("Раскрой").Activate

End Sub

Sub Task7_DB()

UserForm1.ComboBox1.Clear

UserForm1.ComboBox2.Clear

UserForm1.ComboBox3.Clear

UserForm1.ComboBox1.AddItem ("Директор")

UserForm1.ComboBox1.AddItem ("Зам. директора")

UserForm1.ComboBox1.AddItem ("Менеджер")

UserForm1.ComboBox1.AddItem ("Сектетарь")

UserForm1.ComboBox1.AddItem ("Администратор")

UserForm1.ComboBox1.AddItem ("Охрана")

UserForm1.ComboBox1.AddItem ("Водитель")

UserForm1.ComboBox1.AddItem ("Сторож")

UserForm1.ComboBox1.AddItem ("Уборщик")

UserForm1.ComboBox2.AddItem ("10 лет.")

UserForm1.ComboBox2.AddItem ("9 лет.")

UserForm1.ComboBox2.AddItem ("8 лет.")

UserForm1.ComboBox2.AddItem ("3 года.")

UserForm1.ComboBox2.AddItem ("2 года.")

UserForm1.ComboBox2.AddItem ("1 год.")

UserForm1.ComboBox2.AddItem ("меньше года.")

UserForm1.ComboBox3.AddItem ("5 часов")

UserForm1.ComboBox3.AddItem ("6 часов")

UserForm1.ComboBox3.AddItem ("7 часов")

UserForm1.ComboBox3.AddItem ("8 часов")

UserForm1.Show

End Sub

Sub Task7_List()

Worksheets("БД").Activate

End Sub

Sub Model_of_storekeeping()

 UserForm2.Show

End Sub

Модуль 3:

Option Explicit

'МОДЕЛЬ УПРАВЛЕНИЯ ЗАПАСАМИ

Function CALC(buy As Variant) As Variant

Dim Цена_продажы, Цена_покупки, Цена_возврата, NRows, i, j As Integer, Result() As Integer

NRows = buy.Rows.Count

Цена_продажы = Range("a2").Value

Цена_покупки = Range("b2").Value

Цена_возврата = Range("c2").Value

ReDim Result(NRows, NRows)

For i = 1 To NRows

For j = 1 To NRows

If i <= j Then Result(i, j) = buy(i) * (Цена_продажы - Цена_покупки)

If i > j Then Result(i, j) = buy(j) * (Цена_продажы - Цена_покупки) - (buy(i) - buy(j)) * (Цена_покупки - Цена_возврата)

Next j

Next i

CALC = Result

End Function

Sub Begin()

Worksheets("Содержание").Activate

End Sub

Sub Optimum_capital_investmentsEVR()

Dim i, j, k, n, p, l, t As Integer

Dim m, r(), A() As Double

    k = 7

    ReDim r(k + 1, 6), A(k + 1)

    For i = 1 To k + 1

    For j = 2 To 7

        r(i, j - 1) = Cells(i + 3, j).Value

    Next j

    Next i

    t = 2

    For p = 2 To 6

        If p = 2 Then

            For j = 1 To k + 1

                A(j) = Cells(j + 3, 2).Value

            Next j

        End If

        If p > 2 Then

            For j = 1 To k + 1

                A(j) = Cells(j + 3, p + 5).Value

            Next j

        End If

        For n = 1 To k + 1

            m = -1

            For j = 1 To n

                If m < A(j) + r(n + 1 - j, p) Then

                    m = A(j) + r(n + 1 - j, p)

                End If

            Next j

                Cells(n + 3, 6 + p).Value = m

            l = t

            For j = 1 To n

                If m = A(j) + r(n + 1 - j, p) Then

                    Cells(n + 6 + k, l).Value = j - 1

                    Cells(n + 6 + k, l + 1).Value = n - j

                l = l + 2

                End If

            Next j

        Next n

        t = l

    Next p

End Sub

Модуль 4:

Sub Раскрой()

Dim r, i1, i2, i3, i4, s, t As Integer

Dim l, a1, a2, a3, a4, a5, m As Integer

'Dim F, TT, SS, ZZ As String

l = 28

a1 = 4: a2 = 6

a3 = 9: a4 = 11

r = 4

m = Application.Min(a1, a2, a3, a4)

t = Application.Floor(l / m, 1)

For i1 = 0 To t

For i2 = 0 To t

For i3 = 0 To t

For i4 = 0 To t

s = 28 - a1 * i1 - a2 * i2 - a3 * i3 - a4 * i4

If s >= 0 And s < m Then

Cells(r, 1).Value = r - 3

Cells(r, 2).Value = i1

Cells(r, 3).Value = i2

Cells(r, 4).Value = i3

Cells(r, 5).Value = i4

Cells(r, 6).Value = s

r = r + 1

End If

Next i4

Next i3

Next i2

Next i1

Range("J4").FormulaLocal = "=СУММПРОИЗВ($I$4:$I$" & r - 1 & ";B4:B" & r - 1 & ")"

Range("K4").FormulaLocal = "=СУММПРОИЗВ($I$4:$I$" & r - 1 & ";C4:C" & r - 1 & ")"

Range("L4").FormulaLocal = "=СУММПРОИЗВ($I$4:$I$" & r - 1 & ";D4:D" & r - 1 & ")"

Range("M4").FormulaLocal = "=СУММПРОИЗВ($I$4:$I$" & r - 1 & ";E4:E" & r - 1 & ")"

Range("N4").FormulaLocal = "=СУММПРОИЗВ($I$4:$I$" & r - 1 & ";F4:F" & r - 1 & ")+B3*(СУММПРОИЗВ($I$4:$I$" & r - 1 & ";B4:B" & r - 1 & ")-J3)+C3*(СУММПРОИЗВ($I$4:$I$" & r - 1 & ";C4:C" & r - 1 & ")-K3)+D3*(СУММПРОИЗВ($I$4:$I$" & r - 1 & ";D4:D" & r - 1 & ")-L3)+E3*(СУММПРОИЗВ($I$4:$I$" & r - 1 & ";E4:E" & r - 1 & ")-M3)"

End Sub

Sub Optimum_capital_investments()

Worksheets("Опт.капитал").Activate

End Sub

UserFORM1

Обработчик события кнопки <OK>

Private Sub CommandButton1_Click()

If UserForm1.TextBox1.Text = "" Then GoTo ll

i = 0

Do

i = i + 1

Loop Until Worksheets("БД").Cells(i, 1) = ""

Worksheets("БД").Cells(i, 1) = UserForm1.TextBox1.Text

Worksheets("БД").Cells(i, 2) = UserForm1.TextBox3.Text

If UserForm1.CheckBox2 = True Then

   Worksheets("БД").Cells(i, 6) = "Есть"

   Else

   Worksheets("БД").Cells(i, 6) = "Нет"

End If

 If UserForm1.CheckBox1 = True Then

 Worksheets("БД").Cells(i, 7) = "Есть"

 Else

 Worksheets("БД").Cells(i, 7) = "Нет"

End If

Worksheets("БД").Cells(i, 8) = UserForm1.TextBox5.Text + " грв."

Worksheets("БД").Cells(i, 9) = UserForm1.TextBox2.Text

Worksheets("БД").Cells(i, 10) = UserForm1.TextBox6.Text + " мес."

If UserForm1.OptionButton3 = True Then Worksheets("БД").Cells(i, 11).Value = "Есть семья"

If UserForm1.OptionButton4 = True Then Worksheets("БД").Cells(i, 11).Value = "Нет семьи"

If UserForm1.OptionButton5 = True Then Worksheets("БД").Cells(i, 12).Value = " M "

If UserForm1.OptionButton6 = True Then Worksheets("БД").Cells(i, 12).Value = " Ж "

Worksheets("БД").Cells(i, 3).Value = ComboBox1.Value

Worksheets("БД").Cells(i, 4).Value = ComboBox2.Value

Worksheets("БД").Cells(i, 5).Value = ComboBox3.Value

ll:

UserForm1.Hide

Worksheets("БД").Activate

End Sub

Обработчик события кнопки <Cancel>

Private Sub CommandButton2_Click()

UserForm1.Hide

Worksheets("БД").Activate

End Sub

UserForm2

Обработчик события кнопки <OK>

Private Sub CommandButton1_Click()

 Worksheets("Задание4").Range("c10:h15").Value = ""

 Worksheets("Задание4").Range("j11:j16").Value = ""

  Worksheets("Задание4").Range("b2").Value = UserForm2.TextBox1

  Worksheets("Задание4").Range("a2").Value = UserForm2.TextBox2

  Worksheets("Задание4").Range("c2").Value = UserForm2.TextBox3

  UserForm2.Hide

  Range("C10:H15").FormulaArray = "=Модуль3.CALC(I11:I16)"

  Range("J11:J16").FormulaArray = "=MMULT((C10:H15),TRANSPOSE(d7:i7))"

  Range("f16").Select

  ActiveCell.FormulaR1C1 = "=large(r[-5]c[4]:rc[4],1)"

  Range("f17").Select

  ActiveCell.FormulaR1C1 = "=(match(large(r[-6]c[4]:r[-1]c[4],1),r[-6]c[4]:r[-1]c[4],0)-1)*5"

  r = Range("f16").Value

  v = Range("f17").Value

  UserForm3.Label3.Caption = Worksheets("Задание4").Range("f16")

  UserForm3.Label4.Caption = Worksheets("Задание4").Range("f17")

  UserForm3.Show

End Sub

Обработчик события кнопки <Cancel>

Private Sub CommandButton2_Click()

 UserForm2.Hide

End Sub

UserForm3

Private Sub CommandButton1_Click()

 UserForm3.Hide

End Sub