Решение экономических задач с помощью VBA (стр. 9 из 10)

Â ìàêðîñå îòâå÷àþùåì çà ñîáûòèå êíîïêè «Äîáàâëåíèå» ââåäåì ïðîöåäóðó êîòîðàÿ áóäåò àêòèâèçèðîâàòü ôîðìó 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

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

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

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

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

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

i = i + 1

AA_2(i) = Worksheets("Çàäàíèå3").Cells(i + 2, 7).Value

Loop Until i = 9

Max = -1

i = 0

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

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

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

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

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

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

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

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))

For i = 1 To 4

For j = 1 To 4

Worksheets("Çàäàíèå5").Cells(i + 2, j).Value = G(i, j)

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)

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 ("Îõðàíà")