Файл: Контрольная работа по теме Базы данных в Excel 72 IV. Макросы в ms excel 78 Макросы для автоматизации работ 78.doc

15. Поголовье коров в сельскохозяйственных организациях (на 1 января; голов)

	1996	1998	1999	2000	2001	2002	2003	2004	2005
Алатырский	5321	3754	3487	3233	2894	2627	2550	2317	1872
Аликовский	4111	3913	3797	3858	3725	3562	3279	3086	2686
Батыревский	4656	4005	3748	3649	3355	3055	3020	2650	1870
Вурнарский	5550	4915	4897	4465	3996	3864	3798	3459	2970
Ибресинский	2869	2694	2687	2636	2538	2317	2250	2035	1814
Канашский	6065	5039	4893	4475	3733	3618	3421	2901	2194
Козловский	2513	1840	1651	1456	1158	1101	976	822	645
Комсомольский	3339	3190	3075	2981	2904	2836	2768	2507	2267
Красноармейский	3309	3004	2890	2739	2422	2408	2408	2179	1690
Красночетайский	2916	2646	2593	2581	2510	2386	2363	2210	2010
Марпосадский	3040	2508	2235	1948	1811	1552	1258	977	836
Моргаушский	5260	5074	5075	5030	4987	4887	4802	4500	3871
Порецкий	3861	3163	2977	2719	2418	2316	2136	1761	1522
Урмарский	3027	2453	2798	2627	2201	2022	2022	1304	1012
Цивильский	4738	3731	3827	3477	3034	2940	2811	2564	2148
Чебоксарский	7230	6571	6485	5882	5381	5225	5019	4483	3801
Шемуршинский	2255	2179	2043	1869	1742	1569	1419	1207	909
Шумерлинский	2422	1898	1806	1819	1599	1411	1249	930	767
Ядринский	4578	4018	4167	3903	3631	3557	3535	3247	3010
Яльчикский	4270	3730	3742	3581	3545	3502	3503	3493	3079
Янтиковский	3029	2854	2837	2683	2511	2483	2441	2135	1861

---

---

Приложение 3

Тексты макросов

Текст макроса для кластерного анализа
OptionExplicit

Constn = 14 ' Количество объектов

Dimx(n) AsDouble ' Массивы координат (параметров)

Dim y(n) As Double ' объектов

Dims(n, n) AsDouble ' Матрица расстояний между объектами

DimChain(3, n - 1) AsDouble 'Массив параметров цепочки расстояний

' 1-ый параметр - расстояние

' 2-ой параметр – номер первого объекта

' 3-ий параметр – номер второго объекта

Dim Checked(n) As Boolean ' Массив выбранных объектов

Dim i, j, k As Integer '

Dim Imin As Integer '

Dim Jmin As Integer '

Dim MinS As Double '

Dim Xmin As Double ' Переменные,

Dim Xmax As Double ' необходимые

Dim Ymin As Double ' для нормирования

Dim Ymax As Double ' данных
Private Sub CommandButton1_Click()

' Считывание данных

For i = 1 To n: x(i) = Cells(i + 5, 3): Next

For i = 1 To n: y(i) = Cells(i + 5, 4): Next

'

' Нормирование данных

'

' Определение границ параметров объектов

Xmin = 1E+38: Xmax = -1E+38

Ymin = 1E+38: Ymax = -1E+38

For i = 1 To n

If x(i) < Xmin Then Xmin = x(i)

If x(i) > Xmax Then Xmax = x(i)

If y(i) < Ymin Then Ymin = x(i)

If y(i) > Ymax Then Ymax = x(i)

Next

' Пересчет в нормированные значения (на диапазон 0..100)

For i = 1 To n

x(i) = 100 * (x(i) - Xmin) / (Xmax - Xmin)

y(i) = 100 * (y(i) - Ymin) / (Ymax - Ymin)

Next
' Расчет матрицы расстояний между объектами

For i = 1 To n

For j = 1 To n

s(i, j) = Sqr((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2)

Next

Next
For i = 1 To n: Checked(i) = False: Next
' Нахождение первой пары наиболее близких объектов

k = 1

MinS = 1E+38

For i = 1 To n - 1

For j = 2 To n

If s(i, j) < MinS And i <> j Then

MinS = s(i, j): Imin = i: Jmin = j

EndIf

Next

Next
'Цикл расчета массива цепочки расстояний

k = 1

While k < n - 1

k = k + 1

MinS = 1E+38

For i = 1 To n - 1

For j = 2 To n

If (s(i, j) < MinS) And (i <> j) And _

---

(Checked(i) And Not Checked(j) Or _

Not Checked(i) And Checked(j)) Then

MinS = s(i, j): Imin = i: Jmin = j

End If

Next

Next
' Параметры очередной пары наиболее близких объектов

Chain(1, k) = MinS

Chain(2, k) = Imin

Chain(3, k) = Jmin

Checked(Imin) = True: Checked(Jmin) = True

Wend
'Вывод цепочки расстояний на экран

For i = 1 To n - 1

Cells(i + 10, 6) = Chain(1, i)

Cells(i + 10, 7) = Chain(2, i)

Cells(i + 10, 8) = Chain(3, i)

Next
End Sub
Текст макроса для решения систем дифференциальных уравнений
Option Explicit

Dim N(3) As Double

Dim F(3) As Double
Dim k1, k2, k3, k4, k5, k6 As Double

Dim T, tt, dt As Double

Dim i, k, h, nPeriod As Integer
Sub Systema()

F(1) = k1 * N(1) - k2 * N(1) * N(2)

F(2) = -k3 * N(2) + k4 * N(1) * N(2)

F(3) = 0

End Sub
Private Sub CommandButton1_Click()
For i = 1 To 3: N(i) = Cells(7 + i, 2): Next
k1 = Cells(16, 2): k2 = Cells(17, 2)

k3 = Cells(18, 2): k4 = Cells(19, 2)

k5 = Cells(20, 2): k6 = Cells(21, 2)
T = Cells(12, 2)

dt = Cells(13, 2)

nPeriod = Int(T / 50 / dt)

k = 8

Cells(k, 4) = 0

For i = 1 To 3: Cells(k, 4 + i) = N(i): Next
tt = 0: h = 0

While tt < T

h = h + 1

tt = tt + dt

Call Systema

For i = 1 To 3: N(i) = N(i) + F(i) * dt: Next

If h = nPeriod Then

k = k + 1

Cells(k, 4) = tt

For i = 1 To 3: Cells(k, 4 + i) = N(i): Next

h = 0

End If

Wend
End Sub
Текст макроса для генерации временного ряда
Private Sub CommandButton1_Click()

Randomize Timer

Tip = Int(1 + 4 * Rnd(Timer))

Cells(2, 12) = Tip: 'Tip = 4

For i = 1 To 50

If Tip = 1 Then y = 60 + 200 * i + 600 * Sin(i / 2) + (-300 + 600 * Rnd(Timer))

If Tip = 2 Then y = 50 * Log(i) + 20 * Sin(i / 2) + (-10 + 20 * Rnd(Timer))

If Tip = 3 Then y = 20 + 5 * 2 ^ (i / 10) + 20 * Sin(i / 2) + (-10 + 20 * Rnd(Timer))

If Tip = 4 Then y = 50 + 300 * 2 ^ (-i / 5) + 30 * Sin(i / 2) + (-20 + 40 * Rnd(Timer))

Cells(i + 4, 2) = i

Cells(i + 4, 3) = y

Next

End Sub

---

Приложение 4

Транспорт и связь

(данные по Чувашской республике [11])
1. Во всех вариантах получить уравнение регрессии, адекватно описывающее представленные данные.

2. Для расчетов не использовать данные за 2004 год.

3. Данные за 2004 год использовать для сопоставления с результатами прогноза.

4. Для повышения точности расчетов значения годов заменить на их порядковые номера.

Например, года:

1995

1997

1998

1999

2000

2001

2002

2003

2004

заменить на:

1

3

4

5

6

7

8

9

10

1. Перевозки грузов автомобильным транспортом всех отраслей экономики (по хозяйствам, в распоряжении которых 10 и более грузовых автомобилей; тысяч тонн)

1995	1997	1998	1999	2000	2001	2002	2003	2004
32872,1	22595,3	19264,9	18096,5	20374,5	17835,8	15736,5	21818,5	17467,8

2. Грузооборот автомобильного транспорта всех отраслей экономики (по хозяйствам, в распоряжении которых 10 и более грузовых автомобилей; тысяч тонно-километров)

1995	1997	1998	1999	2000	2001	2002	2003	2004
787506,2	581921,2	513206,1	557120,9	482524,5	487927,2	629398,1	955533,8	599922,4

---