ПРЕДЛАГАЮ КОЛЛЕГАМ

VBA в приложении к Excel, Word и Power Point

О.А. Житкова, Т.И. Панфилова
Москва

Продолжение. Начало в № 1 – 7, 9/2006

Занятие № 8. Решаем задачи

В этот раз все задачи основываются на материалах предыдущих занятий.

Практическая работа № 8–1 “Выбор оборудования”

Постановка задачи

Для данных, представленных в таблице, вывести на лист список товаров фирмы HP и их цену.

Рассмотрим таблицу. Данные о поставщике записаны во втором столбце, начиная со второй строки. Если, просматривая второй столбец, встретим значение, равное “HP”, выведем на лист название товара, его цену, а также итоговую сумму.

Эта задача реализует следующие алгоритмы:

вывод списка элементов, удовлетворяющих определенному условию;
подсчет суммы элементов, удовлетворяющих определенному условию;
подсчет количества элементов, удовлетворяющих определенному условию.

При решении задачи применяются конструкции: For — Next, If — then — Else — End if, With — End With.

Обратите внимание, что при использовании конструкции With — End With перед именем поля объекта ставится точка.

Порядок работы

1. Переименуйте Лист1 в лист “Задача”.

2. Создайте таблицу “Товар — Поставщик — Цена”.

3. Перейдите в VBA.

4. Создайте модуль.

5. Создайте процедуру с именем HP.

6. Составьте макрос формирования списка.

Public Sub HP()

Dim I As Integer, y As Integer, S As Integer, j As Integer

'Переменная для подсчета количества единиц товара фирмы HP

y = 0

'Переменная для накопления суммы

S = 0

'Переменная для формирования номера строки товара в списке

j = 1

'Открываем цикл с параметром цикла I (номер строки), изменяющимся от 2 до 100 (предполагаем, что заданная таблица может содержать от 2 до 100 строк)

With Sheets("Задача")

For I = 2 To 100

If .Cells(I, 2) = "HP" Then

'Переносим на лист данные таблицы, удовлетворяющие условию

j = j + 1

.Cells(j, 6) = .Cells(I, 1)

.Cells(j, 7) = .Cells(I, 3)

S = S + .Cells(I, 3)

y = y + 1

End If

Next I

'Проверка наличия товара фирмы HP

If y > 0 Then

.Cells(1, 6) = "Товар"

.Cells(1, 7) = "Цены"

.Cells(j + 1, 6) = "Итого"

.Cells(j + 1, 7) = S

.Cells(j + 2, 6) = "Количество единиц товара фирмы"

.Cells(j + 2, 7) = y

Else

.Cells(1, 6) = "Такого товара нет"

End If

End With

End Sub

7. Запишите макрорекордер “Очистка” для удаления списка.

Sub Очистка()

'Очистка

'Макрос записан 26.12.2003 (Ольга)

Range("E1:H21").Select

Selection.ClearContents

End Sub

8. Подготовьте два графических объекта.

9. Назначьте им подготовленные макросы.

10. Проверьте работоспособность макросов.

11. Сохраните работу.

На листе у вас должна получиться примерно такая картина:

Практическая работа № 8–2 “Сотрудники”

Постановка задачи

Заполнить лист “Сотрудники” с помощью пользовательской формы “Карточка сотрудника”. В пользовательской форме спроектировать поле со списком специальностей, которые находятся на листе “Профессии”.

Эта задача реализует алгоритм заполнения поля со списком в пользовательской форме и запись на лист Excel данных, введенных в пользовательскую форму.

Поле со списком (ComboBox) — это элемент управления, который применяется для хранения списка значений. Список значений заранее создается на листе Excel и программно формируется для использования его в пользовательской форме.

Особенность нашей задачи заключается в том, что список специальностей, занесенных на лист Excel, может все время дополняться. Поэтому, чтобы узнать диапазон ячеек, заполненных специальностями, и программно сформировать поле со списком в пользовательской форме, следует использовать определенный алгоритм.

Решение задачи состоит из двух этапов:

Вызов формы на экран и формирование поля со списком специальностей;
Запись на лист Excel введенной информации (при нажатии на кнопку “ОК”).

Порядок работы

1. Переименуйте Лист1 в лист “Сотрудники”, а Лист2 — в “Профессии”.

2. Подготовьте на листе “Сотрудники” шапку таблицы, в которую через пользовательскую форму будет заноситься информация.

3. Составьте на листе “Профессии” список специальностей.

4. Спроектируйте форму UserForm1 и назовите ее “Карточка сотрудника”.

5. Подготовьте на листе “Сотрудники” кнопку “Заполнение списка”. При нажатии на эту кнопку должна появляться подготовленная пользовательская форма, позволяющая создавать поле со списком специальностей. Создадим событийную процедуру нажатия на кнопку.

Алгоритм формирования источника информации для поля со списком в пользовательской форме

A. Определите количество строк, заполненных специальностями, на листе “Профессии”.

Количество непустых ячеек в указанном диапазоне подсчитывает функция рабочего листа CountA. В качестве диапазона мы будем рассматривать весь столбец А:

Range("A:A").

Так как это функция, то необходимо указать, какой переменной мы присвоим вычисленное значение. В нашей задаче мы назвали эту переменную “список”.

Список =

Application.CountA(Sheets("Профессии").Range("A:A"))

В результате работы функции наша переменная “список” примет значение 7.

В. Сформируйте диапазон списка специальностей.

Мы знаем, что адрес начальной ячейки диапазона на листе “Профессии” — А1. Адрес конечной ячейки диапазона получится путем “склеивания” имени столбца А и значения, которое хранится в переменной “список”. Но переменная “список” объявлена как тип Integer, а “склеивание” можно применять только к строковым переменным. Поэтому мы должны к переменной “список” применить функцию CStr: эта функция меняет тип данных у переменных. После этого можно провести “склеивание” и присвоить полученный диапазон новой переменной.

Д_списка = "A1:A" & CStr(список)

В результате работы новой переменной Д_списка будет присвоен диапазон A1:A7.

С. Присвойте сформированному диапазону имя “Специальности”.

Используем свойство Name объекта Range, расположенного на листе “Профессии”.

Sheets("Профессии").Range(Д_списка).Name = "Специальности"

В результате работы диапазону A1:A7 на листе “Профессии” будет присвоено имя “Специальности”.

D. Присоедините к полю в пользовательской форме список специальностей.

ComboBox1 — объект “поле со списком” в пользовательской форме. RowSource — свойство объекта “источник-строка”. То есть источником для формирования поля со списком является диапазон ячеек с именем “Специальности”.

.ComboBox1.RowSource = "Специальности"

Программа формирования источника информации для поля со списком в пользовательской форме получится такая:

Private Sub CommandButton1_Click()

Dim список As Integer

список =

Application.CountA(Sheets("Профессии").Range("A:A"))

'Определим диапазон списка специальностей

Д_списка = "A1:A" & CStr(список)

'Присвоим имя диапазону списка специальностей

Sheets("Профессии").Range(Д_списка).Name = "Специальности"

'Очистим ячейки

With UserForm1

.TextBox1.Text = ""

.ComboBox1.Text = ""

'Введем список для поля со списком

.ComboBox1.RowSource = "Специальности"

'Выведем пользовательскую форму на экран

.Show

End With

End Sub

6. Создайте процедуру для записи (при нажатии на кнопку “ОК”) данных о сотруднике из пользовательской формы на лист “Сотрудники”.

Private Sub CommandButton1_Click()

Dim фамилия As String, специальность As String

Dim строка As Integer, имя As String

'строка - номер последней заполненной строки на листе "Сотрудники"

'Определим номер последней заполненной строки

строка =

Application.CountA(Sheets("Сотрудники").Range("A:A"))

With UserForm1

'переменным "фамилия" и "имя" присвоим содержимое поля TextBox1 и TextBox2

фамилия = .TextBox1.Text

имя = .TextBox2.Text

'переменной "специальность" присвоим содержимое поля ComboBox1

специальность = .ComboBox1.Text

End With

With Sheets("Сотрудники")

.Cells(строка + 1, 1) = фамилия

.Cells(строка + 1, 2) = имя

.Cells(строка + 1, 3) = специальность

End With

'Очистим содержимое ComboBox1.Text, TextBox1.Tex и ТextBox2.Text

UserForm1.ComboBox1.Text = ""

UserForm1.TextBox1.Text = ""

UserForm1.TextBox2.Text = ""

End Sub

7. Запишите процедуру закрытия формы.

Private Sub CommandButton2_Click()

UserForm1.Hide

End Sub

8. Проверьте вашу работу и сохраните ее.

Практическая работа № 8–3 “Работа с матрицей”

Постановка задачи

На листе Excel подготовить матрицу, размерность которой формируется с помощью запроса о количестве строк и столбцов. При этом количество строк и столбцов не должно превышать десяти. Элементы матрицы вводятся с применением датчика случайных чисел в диапазоне от 0 до 9. Спроектировать пользовательскую форму “Операции с матрицей”. В форме предусмотреть кнопки “Ввод матрицы”, “Вычислить”, “Очистить лист”, “Выход”.

При нажатии на кнопку “Ввод матрицы” формируется матрица на листе Excel. При нажатии на кнопку “Вычислить” должна подсчитываться сумма элементов матрицы, производиться поиск наибольшего элемента или происходить замена четных элементов на нечетные. Какая из этих операций будет выполняться, необходимо указать с помощью элемента Переключатель (OptionButton).

При нажатии на кнопку “Очистить лист” с листа “Матрицы” должно происходить удаление самой матрицы и всех результатов работы с ней.

Кнопка “Выход” закрывает форму.

Вызывать пользовательскую форму “Операции с матрицей” должна кнопка “Работа с матрицей” на листе Excel.

Порядок работы

1. Спроектируйте пользовательскую форму UserForm1 “Операции с матрицей”.

2. Напишите программы для кнопок.

Кнопка “Очистить лист”

Private Sub CommandButton2_Click()

For i = 1 To 30

For j = 1 To 30

Worksheets("Матрица").Cells(i, j).Value = ""

Next j

Next i

End Sub

Кнопка “Выход”

Private Sub CommandButton1_Click()

Userform1.Hide

End Sub

Кнопка “Ввод матрицы”

Private Sub CommandButton4_Click()

m = InputBox("Введите количество столбцов

матрицы", "Ввод")

If m > 10 Then

MsgBox "Количество столбцов более 10

не обрабатываю!", 48, "Ошибка!"

GoTo metka

End If

n = InputBox("Введите количество строк", "Ввод")

If n > 10 Then

MsgBox " Количество строк более 10 не обрабатываю!", 48, "Ошибка!"

GoTo metka

End If

For i = 1 To m

For j = 1 To n

Randomize

matr(i, j) = Int(10 * Rnd)

Next j

Next i

Worksheets("Матрица").Cells(1, 1).Value =

"Матрица"

For i = 1 To m

For j = 1 To n

Worksheets("Матрица").Cells(i + 1, j).Value = matr(i, j)

Next j

Next i

metka:

End Sub

При нажатии на кнопку “Ввод матрицы” должно появляться окно сообщения для ввода количества строк и столбцов матрицы.

Если ввести число, превышающее 10, появится окно сообщения.

Кнопка “Вычислить”

'выполнение действий над матрицей

Private Sub CommandButton6_Click()

Dim MAX As Integer

Dim i As Integer

Dim j As Integer

Dim SUM As Integer

Dim flag As Integer

'определение суммы

SUM = 0

flag = 0

If OptionButton1.Value = True Then

For i = 2 To m + 1

For j = 1 To n

SUM = SUM + Worksheets("Матрица").Cells(i, j)

Next j

Next i

Worksheets("Матрица").Cells(11, 1).Value = "Сумма элементов ="

Worksheets("Матрица").Cells(12, 1).Value = SUM

MsgBox "=" & SUM, 48, " Сумма элементов"

GoTo metka

End If

' определение максимума

If OptionButton2.Value = True Then

MAX = Worksheets("Матрица").Cells(2, 1).Value

For i = 2 To m + 1

For j = 1 To n

If MAX < Worksheets("Матрица").Cells(i, j)

Then

MAX = Worksheets("Матрица").Cells(i, j)

End If

Next j

Next i

Worksheets("Матрица").Cells(11, 1).Value = "Максимальный элемент"

Worksheets("Матрица").Cells(12, 1).Value = MAX

MsgBox "=" & MAX, 48, " Максимальный элемент"

GoTo metka

End If

'замена четных

If OptionButton3.Value = True Then

For i = 2 To m + 1

For j = 1 To n

d = Worksheets("Матрица").Cells(i, j)

If d / 2 = Int(d / 2) Then

Worksheets("Матрица").Cells(i, j) = d + 1

flag = 1

End If

Next j

Next i

If flag = 1 Then

MsgBox "Замена произошла", 64, "Замена"

Else

MsgBox "Замены нет, все элементы

нечетные", 64, "Замена"

End If

metka:

End Sub

Результат подсчета суммы элементов или поиска максимального элемента матрицы выводится в ячейку А12, дополнительно появляется окно сообщения:

При выборе операции замены элементов окно сообщения может быть таким:

3. Спроектируйте на листе “Матрица” кнопку “Работа с матрицей”, которая вызывает пользовательскую форму “Операция с матрицей”.

Private Sub Запуск_Click()

Userform1.Show

End Sub

4. Сохраните свою работу.

Практическая работа № 8–4 “Работа с матрицей–2”

Эта работа позволяет понять, что применение функций рабочего листа при работе с матрицами позволяет сделать программу короче.

Постановка задачи

Постановка задачи совпадает с предыдущей (см. практическую работу № 8–3), но количество операций мы расширим и не будем использовать форму для выбора операции. В матрице найдем:

сумму элементов;
минимальный элемент;
максимальный элемент;
произведение элементов;
среднее значение элементов.

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

Порядок работы

Работаем в том же файле Excel, в котором выполнена практическая работа № 8–3.

1. Перейдите в редактор VBA.

2. Создайте модуль.

3. Создайте процедуру vers.

4. Напишите программу.

Public Sub vers()

'Объявление переменных

Dim KStrok As Integer

Dim KStolb As Integer

Dim Stolb As Integer

Dim ad As String

Dim diap As String

Dim SUM As Integer

Dim m As Integer

Dim m1 As Integer

Dim proiz As Long

Dim sr As Long

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

KStrok =

Application.CountA(Sheets("Матрица").Range("B:B"))

KStolb =

Application.CountA(Sheets("Матрица").Range("2:2"))

'Определение адреса правого нижнего элемента матрицы

ad = (Sheets("Матрица").Cells(KStrok + 1,

KStolb).Address())

'Формирование диапазона расположения матрицы

diap = "A2:" & ad

'Вычисление суммы

SUM =

Application.SUM(Sheets("Матрица").Range(diap))

'Нахождение минимума

m =

Application.Min(Sheets("Матрица").Range(diap))

'Нахождение максимума

m1 =

Application.MAX(Sheets("Матрица").Range(diap))

'Произведение

proiz =

Application.Product(Sheets("Матрица").Range(diap))

'Среднее значение

sr =

Application.Average(Sheets("Матрица").Range(diap))

'Строка для вывода результатов

Stroka = 1

'Столбец для вывода результатов

Stolb = KStolb + 2

' Вывод результатов