48829 (Решение экономических и бухгалтерских задач с использованием инструментария Visual Basic For Application), страница 2

'главная программа

Sub копирование ()

Sheets ("Лист3"). Select

Dim A () As Variant, m, n As Integer 'объявление динамического двумерного массива

'обращение к подпрограмме ввода данных в память

n = Sheets ("Лист2"). Cells (5,11) ' кол-во строк

m = Sheets ("Лист2"). Cells (5,12) ' кол-во столбцов

ReDim A (1 To n, 1 To m) ' переобъявление массива

'процедура ввода

VVOD "Лист2", A, n, m, 3 'список фактических параметров, где:

'Лист2-лист, с которого данные вводятся в память;

'а-имя массива;

'n-количество строк массива;

'm-количество столбцов массива;

'3-количество строк заголовка таблицы.

'обращение к подпрограмме вывода данных на лист

VIVOD "Лист3", A, n, m, 3 'вывод из памяти на Л3

VIVOD "Лист4", A, n, m, 3 'вывод из памяти на Л4

End Sub

'Подпрограмма "VVOD":

Sub VVOD (L, x, y, r, S) 'список фактических пареметров, где:

'L-лист;

'x-имя массива;

'y-количество строк в массиве;

'r-количество столбцов в массиве;

'S-колчество строк заголовков таблицы

For i = 1 To y

For j = 1 To r

x (i, j) = Sheets (L). Cells (i + S, j)

Next j

Next i

End Sub

'Подпрограмма "VIVOD":

Sub VIVOD (L, x, y, r, S)

For i = 1 To y

For j = 1 To r

Sheets (L). Cells (i + S, j) = x (i, j)

Next j

Next i

End Sub

Рис.3 Программа применения процедур ввода и вывода

6. Дозапись исходных данных

Для реализации действий, используется оператор Slect Case.

Синтаксис:

Slect Case

Case

……………………

Case

……………………

Case

……………………

C Листа2 копируем исходные данные на Лист4 (процедурами ввода данных в память и вывода на лист). Объявляем матрицу как динамичесий массив. Считываем с Листа 2 количество строк (n) и столбцов (m), размерность которой будет n*m. Вводим новую матрицу в память, затем на лист. Формируем новую матрицу, чтобы выполнить дозапись. Ввод данных производится через оператор InputBox, ввод новых элементов выполняется в цикле For. Снова переобъявляем матрицу, размерность которой уже будет (n+k) *m. Выводим на лист новую матрицу.

Sub Дозапись ()

Sheets ("Лист4"). Select

Dim A () As Variant 'объявление динамического двумерного массива

'обращение к подпрограмме ввода данных в память

n = Sheets ("Лист2"). Cells (5,11) 'количество строк массива

m = 5 'количество столбцов массива

ReDim A (1 To n, 1 To m)

k = InputBox ("Введите количество дозаписываемых элементов")

Sheets ("Лист4"). Cells (5, 13) = k 'количество дозаписываемых элементов

ReDim A (1 To n + k, 1 To m) As Variant

For i = 1 To n

For j = 1 To m 'столбцы для дозаписи даннных

A (i, j) = Sheets ("Лист4"). Cells (i + 2, j)

Next j

Next i

'вывод новых элементов на Л4

For i = 1 To k

For j = 1 To m

If j = 1 Then 'номера столбцов, по которым вводятся данные

'y указывает наименование переменной вводимого столбца

y = "Номер группы"

Else

If j = 2 Then

y = "Количество 5"

Else

If j = 3 Then

y = "Количество 4"

Else

If j = 4 Then

y = "Количество 3"

Else

If j = 5 Then

y = "Количество 2"

End If

End If

End If

End If

End If

A (i + n, j) = InputBox (y)

Sheets ("Лист4"). Cells (i + 4 + n, j) = A (i + n, j)

Next j

Next i

n1 = n + k

Sheets ("Лист4"). Cells (5,12) = n1

End Sub

Рис.4. Данные программы после дозаписи

7. Создание отчёта

В отчете производим копирование данных с Листа 4 на Лист 5 и с помощью одномерного массива рассчитывается новые столбцы: "Итого", "Абсолютная успеваемость" и "Качественная успеваемость". Для нахождения производим расчет по формулам: n=n2+n3+n4+n5; absu= (n3+n4+n5) /n*100; kau= (n4+n5) /n*100. Производим считывание количества строк (n) и столбцов (m). Объявляем матрицу A как динамический массив через оператор ReDim. Копируем данные с листа 4 на лист 5 с помощью процедур. Затем высчитываем по формулам значения, а после находим среднее значение в столбцах "Итого", "Абсолютная успеваемость" и "Качественная успеваемость". И выводим на лист:

Sub Отчет ()

Sheets ("Лист5"). Select

Dim A () As Variant

n1 = Sheets ("Лист4"). Cells (5,12) 'количество строк массива

M1 = Sheets ("Лист2"). Cells (5,12) 'количество столбцов массива

ReDim A (1 To n1, 1 To M1)

'Ввод данных в память c Листа4 и вывод на Лист5

VVOD "Лист4", A, n1, M1, 4

VIVOD "Лист5", A, n1, M1, 4

S = 0 ' S-ячейка для подсчета итоговой суммы по графе Средняя годовая стоимость имущества

'Составление отчета

For i = 1 To n1

For j = 1 To M1

A (i,

6) = A (i,

2) + A (i,

3) + A (i,

4) + A (i,

5)

Sheets ("Лист5"). Cells (i + 4,6) = A (i,

6)

Next j

S = S + A (i,

6)

Sr = S / n1

Sheets ("Лист5"). Cells (18,6) = Sr

Next i

S = 0

For i = 1 To n1

For j = 1 To M1

A (i,

7) = (A (i,

4) + A (i,

3) + A (i,

2)) / A (i,

6) * 100

Sheets ("Лист5"). Cells (i + 4,7) = A (i,

7)

Next j

S = S + A (i,

7)

Sr = S / 13

Sheets ("Лист5"). Cells (18,7) = Sr

Next i

S = 0

For i = 1 To n1

For j = 1 To M1

A (i,

8) = (A (i,

3) + A (i,

2)) / A (i,

6) * 100

Sheets ("Лист5"). Cells (i + 4,8) = A (i,

8)

Next j

S = S + A (i,

8)

Sr = S / n1

Sheets ("Лист5"). Cells (18,8) = Sr

Next i

Sheets ("Лист5"). Cells (18,1) = "В среднем"

End Sub

Рис.5. Данные таблицы после создания Отчёта

8. Сортировка данных

Произвести сортировку данных с Листа5 по столбцу "Абсолютная успеваемость, проц." (таблица 5, лист6).

Необходимо отсортировать данные, полученные в предыдущей программе по возрастанию. При сортировке двумерного массива ипользуется вложенные циклы. Во внешнем цикле используется оператор Do While…Lope, заключённые в нём операторы выполняются до тех пор, пока остаётся истинным условие While. Внутри цикла Do While выполняется два цикла For…Next.

Синтаксис:

For Счётчик1= To [Step Шаг]

For Счётчик2= To [Step Шаг]

[Оператор (ы) тела цикла]

Next Счётчик2

Next Счётчик1

Счётчик по параметру i-количество строк - сортируемый признак предыдущей строки сравнивается с признаком последующей строки. Если признаки первой строки больше признака второй строки, то выполняется цикл по j-количество столбцов, в котором данные этих строк меняются местами.

Sub Сортировка ()

Sheets ("Лист6"). Select

Dim A () As Variant

n1 = Sheets ("Лист4"). Cells (5,12)

m = Sheets ("Лист2"). Cells (5,12)

ReDim A (1 To n1, 1 To m)

VVOD "Лист5", A, n1, m, 4

VIVOD "Лист6", A, n1, m, 4

ReDim A (1 To n1, 1 To m)

For i = 1 To n1

For j = 1 To m

A (i, j) = Sheets ("Лист5"). Cells (i + 4, j)

Sheets ("Лист6"). Cells (i + 4, j) = A (i, j)

Next j

Next i

Z = 1

Do While Z = 1

Z = 0

For i = 1 To n1 - 1

If Sheets ("Лист6"). Cells (i + 4,7) > Sheets ("Лист6"). Cells (i + 4 + 1,7) Then

For j = 1 To m

AZ = Sheets ("Лист6"). Cells (i + 4, j)

Sheets ("Лист6"). Cells (i + 4, j) = Sheets ("Лист6"). Cells (i + 4 + 1, j)

Sheets ("Лист6"). Cells (i + 4 + 1, j) = AZ

Next j

Z = 1

End If

Next i

Loop

End Sub

Рис.6. Данные таблицы после сортировки

9. Создание автоматического макроса по сортировке

Создать автоматический макрос по сортировке по столбцу "Абсолютная успеваемость, проц." (Листа5, табл.6)

Встаем на лист, где будет макрос. Включаем запись макроса Сервис→Макрос→Начать запись→ОК. Появится квадрат, где кнопка остановить запись. На Листе5 (отчет) выделяем таблицу без заголовков и итогов, копируем на Лист9 (автосортировка) в элементе меню выбираем Данные→Сортировка→по возрастанию→по столбцам→ОК. Отмечаем столбец по которому будем сортировать. Нажимаем кнопку остановить запись.

Sub Макрос1Сортировка ()

'

' Макрос1Сортировка Макрос

'

'

Sheets ("Лист5"). Select

Range ("A2: H17"). Select

Selection. Copy

Sheets ("Лист7"). Select

Range ("A2: A3"). Select

ActiveSheet. Paste

Application. CutCopyMode = False

Range ("A5: H17"). Select

ActiveWorkbook. Worksheets ("Лист7"). Sort. SortFields. Clear

ActiveWorkbook. Worksheets ("Лист7"). Sort. SortFields. Add Key: =Range ("A5"), _

SortOn: =xlSortOnValues, Order: =xlAscending, DataOption: =xlSortNormal

With ActiveWorkbook. Worksheets ("Лист7"). Sort

. SetRange Range ("A4: H17")

. Header = xlYes

. MatchCase = True

. Orientation = xlTopToBottom

. SortMethod = xlPinYin

. Apply

End With

End Sub

Рис.7. Данные таблицы после авто-сортировки

10. Выборка данных

Создать отчёт по выборке с Листа5 по столбцу "Качественная успеваемость, проц." (с Листа 8, табл.7)

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

Определить количество элементов нового массива по заданному условию введя переменную с помощью оператора InputBox

Объявить и переобъявить новый массив

Сформировать новый массив. Для этого необходимо задать номер первого элемента нового массива u=1. Затем выполняется цикл, в котором записывается условие выборки по столбцу "Качественная успеваемость, проц. ". Если результат проверки истина, то элемент анализируемого массива становится элементом нового массива.

Вывести новый элемент на Лист 8

Sub ОтчётВыборка ()

Sheets ("Лист8"). Select

Dim A () As Variant

n1 = Sheets ("Лист4"). Cells (5,12)

m = Sheets ("Лист2"). Cells (5,12)

ReDim A (1 To n1, 1 To m)

VVOD "Лист5", A, n1, m, 4

C = InputBox ("Введите условие ")

Sheets ("Лист8"). Cells (5,11) = C

d = 0

For i = 1 To n1

If A (i,

8) > Sheets ("Лист8"). Cells (5,11) Then

d = d + 1

End If

Next i

Sheets ("Лист8"). Cells (5,10) = d

Dim B () As Variant

ReDim B (1 To d, 1 To m)

u = 1

For i = 1 To n1

If A (i,

8) > Sheets ("Лист8"). Cells (5,11) Then