VBA. Практическое программирование
.pdf
Обработка социометрических исследований
нали. Другими словами «если этот участник поставил тому единичку, то не поставил ли тот единичку этому».
Если обе ячейки содержат по единичке, то мы встретили пару и соответственно выполняем ряд действий, а именно окрашиваем обе ячейки и вносим соответствующие фамилии в лист «Pari», а переменную n увеличиваем на 1. Эта переменная указывает нам очередную свободную строку на листе «Pari». Для поиска антипар мы практически выполняем те же действия, но ищем в ячейках «–1». Эти действия реализованы в процедурах pari è antipari.
Для определения рейтинга участника мы вынуждены воспользоваться программным кодом, хотя в функциях рабочего листа есть специальные функции (например «Ранг»), способные решить эту задачу. Код нам поможет разместить участников на отдельном листе, в соответствии с их рангом. Для этого мы используем 3 массива для хранения фамилий fam1, fam2, fam3 и соответствующего количества набранных баллов (положительных, отрицательных, результирующих) — p, ot, it. Эти массивы мы заполняем в процедуре chten, считывая значения из колонок AQ, AR, AS, AT, AU. В процедуре sortp производится сортировка массива фамилий fam1 по положительным баллам. Используется классический метод «всплывающего пузырька». Также реализуются процедуры для сортировки по отрицательным и итоговым баллам (sortot, sortit). Затем в процедуре itog результаты размещаются на листе с таким же именем.
Сведения для печати
Теперь наступила пора еще раз пройтись по таблице и для каждого участника перечислить тех, кого он выбрал в качестве друзей и врагов, а так же тех, кто выбрал его в таких же качествах. Для размещения результатов используем лист pri, и займется этим процедура napri. В этой процедуре необходимо следить, какая строка не занята текстом, чтобы на ней разместить очередные фамилии. Для этого используется переменная stroka, а также переменные p1, p2, p3, p4. В начале процедуры после очистки ячеек от предыдущих данных и определения 3 строки как свободной мы начинаем внешний цикл со счетчиком j и перемещаемся по колонкам таблицы. Для j=3 (первый человек в списке) мы сначала копируем его фамилию на лист pri, а затем двигаемся вниз по 3-ей колонке, перебирая строки с помощью счетчика i во внутреннем цикле. Если в какой-то строке 3 колонки (то есть для 1 —го участ-
101
3. Проекты на VBA
ника) стоит единичка, то это означает его положительный выбор и тогда фамилия из первой колонки этой строки должна попасть на лист pri в группу его друзей, а переменная p1 увеличится на единицу. Затем в повторном цикле мы опять проходим сверху вниз по таблице и находим отрицательные единички с соответствующим переносом выбранных фамилий в разряд «врагов». Потом в этой процедуре за счет перемены мест параметров i è j в адресации яче- ек мы проходим по 3 —й строке и выбираем тех кто выбрал 1-го по списку человека в качестве симпатии или антипатии с соответствующим переносом данных на лист для печати. Прежде чем перейти к следующему участнику (j увеличивается на единицу), мы сравниваем переменные p1 — p4 и определяем, с какой строки надо начинать печатать его фамилию.
Личные сведения
Личные сведения — друзья и враги каждого участника также представлены на листе itog правее рейтинговых списков. Представление этих данных организовано с помощью 5 элементов управления Поле со списком (ComboBox). Представляет интерес использование свойства ListFillRange в данной ситуации. Для первого элемента в качества области со списком выступает часть основной таблицы с фамилиями и порядковыми номерами участников. Пользователю дается возможность выбрать нужного для него участника и тогда запускается процедура, в которой номер участника запоминается под переменной j. В этой процедуре (Private Sub ComboBox1_Change()) также как и в процедуре napri происходит чтение исходной таблицы вдоль колонки или строки, но не по всем участникам, а только по выбранному. Данные переносятся в определенные ячейки листа itog. А эти ячейки как раз и входят в состав области для ListFillRange остальных элементов «Поле со списком». Здесь же заметим, что некоторые столбцы листа itog имеют условное форматирование, чтобы наглядно, с помощью цвета, выделить лидеров и отстающих. Управление условным форматированием реализуется в ячейках I3:J3 этого листа.
В целом о коде
Таким образом код программы размещен на двух листах и оформлен через 3 события. Обратим внимание на то, что некоторые процедуры независимы друг от друг и могут быть исключены
102
Обработка социометрических исследований
из общего кода. Код для одной из кнопок рассмотрен выше. Мы здесь рассматриваем оставшуюся часть кода. Вот он
Option Explicit |
Требование об объявлении |
|
|
типа для каждой переменной |
|
Dim pl As Integer, p2 As Integer |
|
|
Dim p3 As Integer, p4 As Integer |
|
|
Dim pm As Integer, strokA As Integer |
|
|
Dim ff As String, pp As Integer |
Блок General для рабочего |
|
Dim it(40) As Integer, K As Integer |
||
листа Table в котором для |
||
|
||
Dim i As Integer, j As Integer, n As Integer |
объявляются типы переменных |
|
Dim fam1(40) As String, fam2(40) As |
|
|
String, fam3(40) As String |
|
|
Dim Fam(40) As String, p(40) As Integer, |
|
|
ot(40) As Integer |
|
|
|
|
|
Private Sub CommandButton1_Click() |
Процедура под щелчок |
|
|
по кнопке |
|
K = Cells(2, 2) |
Определяем число человек |
|
|
в списке |
|
Pari |
|
|
|
|
|
Antipari |
|
|
|
|
|
Chten |
|
|
|
Поочередно выполняются |
|
Sortp |
||
процедуры, код которых |
||
|
||
Sortot |
||
расположен ниже. |
||
Sortit |
|
|
|
|
|
Itog |
|
|
|
|
|
Napri |
|
|
|
|
|
End Sub |
|
|
|
|
|
|
|
|
Public Sub pari() |
|
|
|
|
|
n = 3 |
Номер первой свободной |
|
|
строки на листе pari в одной |
|
|
из колонок |
|
|
|
|
|
|
103
3. Проекты на VBA
For i = 3 To K + 2 |
Движение по всем ячейкам |
|
For j = i + 1 To K + 2 |
таблицы над главной |
|
диагональю |
||
|
||
If Cells(i, j) = 1 And Cells(j, i) = 1 Then |
Если обнаружены две ячейки |
|
Cells(i, j).Interior.ColorIndex = 4 |
||
относительно главной |
||
Cells(j, i).Interior.ColorIndex = 4 |
диагонали, содержащие по "1", |
|
Worksheets("Pari").Cells(n, 2) = Cells(i, 1) |
то обнаружена "дружная пара", |
|
эти ячейки окрашиваются в |
||
Worksheets("Pari").Cells(n, 3) = Cells(j, 1) |
||
зеленый цвет, сведения о паре |
||
n = n + 1 |
переносятся на лист pari, |
|
End If |
параметр n возрастает. |
|
|
||
Next j, i |
|
|
End Sub |
|
|
|
|
|
|
|
|
Public Sub antipari() |
|
|
n = 3 |
|
|
|
|
|
For i = 3 To K + 2 |
|
|
For j = i + 1 To K + 2 |
|
|
If Cells(i, j) = –1 And Cells(j, i) = –1 Then |
Процедура, аналогичная |
|
|
предыдущей, но с поиском |
|
Cells(i, j).Interior.ColorIndex = 6 |
||
парных ячеек, содержащих |
||
Cells(j, i).Interior.ColorIndex = 6 |
||
"–1" |
||
Worksheets("Pari").Cells(n, 4) = Cells(i, 1) |
|
|
|
|
|
Worksheets("Pari").Cells(n, 5) = Cells(j, 1) |
|
|
n = n + 1 |
|
|
|
|
|
End If |
|
|
Next j, i |
|
|
End Sub |
|
|
|
|
|
|
|
|
Public Sub chten() |
Чтение данных из таблицы в |
|
|
масивы |
|
|
|
|
For j = 3 To K + 2 |
j — счетчик строк |
|
|
|
|
i = j – 2 |
i — номер человека по списку |
|
fam1(i) = Cells(j, 47) |
47 колонка содержит фамилии |
|
|
|
|
fam2(i) = fam1(i) |
Создаем три одинаковых |
|
fam3(i) = fam1(i) |
массива фамилий |
|
|
|
104
|
Обработка социометрических исследований |
|
|
|
|
|
|
|
p(i) = Cells(j, 43) |
|
|
ot(i) = Cells(j, 44) |
|
Считываем баллы |
it(i) = Cells(j, 45) |
|
|
Next j |
|
|
End Sub |
|
|
|
|
|
Public Sub sortp() |
|
Сортировка по |
|
|
положительному рейтингу |
For i = 1 To K |
|
Этот цикл надо проделать К |
|
|
ðàç |
For j = 1 To K – 1 |
|
Двигаемся вдоль массива |
If p(j + 1) > p(j) Then |
|
Сравниваем два соседних |
ff = fam1(j + 1) |
|
элемента и если элемент, |
fam1(j + 1) = fam1(j) |
|
стоящий дальше по списку |
|
больше, то меняем его |
|
fam1(j) = ff |
|
|
|
местами с впереди стоящим, |
|
pp = p(j + 1) |
|
фамилии также меняем |
p(j + 1) = p(j) |
|
местами. Проделав это К раз |
|
мы выстраиваем все баллы и |
|
p(j) = pp |
|
|
|
соответствующие фамилии в |
|
End If |
|
убывающем порядке |
Next j, i |
|
|
End Sub |
|
|
|
|
|
|
|
|
Public Sub sortot() |
|
|
For i = 1 To K |
|
|
|
|
|
For j = 1 To K – 1 |
|
|
If ot(j + 1) > ot(j) Then |
|
|
ff = fam2(j + 1) |
|
Процедура, аналогичная |
|
|
|
fam2(j + 1) = fam2(j) |
|
|
|
предыдущей, но только |
|
fam2(j) = ff |
|
сортируются отрицательные |
pp = ot(j + 1) |
|
баллы |
|
|
|
|
|
|
ot(j + 1) = ot(j) |
|
|
ot(j) = pp |
|
|
|
|
|
End If |
|
|
|
|
|
Next j, i |
|
|
|
|
|
105
3. Проекты на VBA
End Sub |
|
|
|
|
|
Public Sub sortit() |
|
|
For i = 1 To K |
|
|
For j = 1 To K – 1 |
|
|
If it(j + 1) > it(j) Then |
|
|
ff = fam3(j + 1) |
|
|
fam3(j + 1) = fam3(j) |
Сортируются итоговые баллы |
|
fam3(j) = ff |
||
|
||
pp = it(j + 1) |
|
|
it(j + 1) = it(j) |
|
|
it(j) = pp |
|
|
End If |
|
|
Next j, I |
|
|
End Sub |
|
|
|
|
|
Public Sub itog() |
Заполнение листа itog |
|
Worksheets("itog").Range("b3:g50").Clear |
Очистка от предыдущих |
|
Contents |
данных |
|
For i = 1 To K |
|
|
Worksheets("itog").Cells(i + 2, 2) = fam1(i) |
|
|
|
|
|
Worksheets("itog").Cells(i + 2, 3) = p(i) |
|
|
Worksheets("itog").Cells(i + 2, 4) = fam2(i) |
Заполнение рабочего листа itog |
|
отсортированным массивом |
||
|
||
Worksheets("itog").Cells(i + 2, 5) = ot(i) |
||
анных |
||
|
||
Worksheets("itog").Cells(i + 2, 6) = fam3(i) |
||
|
||
Worksheets("itog").Cells(i + 2, 7) = it(i) |
|
|
|
|
|
Next I |
|
|
End Sub |
|
|
|
|
|
Public Sub napri() |
Вывод данных для печати |
|
strokA = 3 |
Первая свободная строка |
|
Worksheets("Pri").Range("a3:e300").Clear |
Очистка от старых данных |
|
|
|
|
For j = 3 To K + 2 |
Внешний цикл, j — номер |
|
|
колонки |
|
|
|
106
Обработка социометрических исследований
pl = 0: p2 = 0: p3 = 0: p4 = 0 |
Число занятых фамилиями для |
|
|
данного человека |
|
Worksheets("Pri").Cells(strokA, 1) = |
Заносим фамилию очередного |
|
Cells(1, j) |
участника |
|
|
|
|
For i = 3 To K + 2 |
Начинаем просмотр таблицы |
|
|
|
|
If Cells(i, j) = 1 Then |
Нашли его положительный |
|
|
выбор |
|
Worksheets("Pri").Cells(strokA + pl, 2) = |
Записали фамилию |
|
Cells(i, 1) |
||
|
||
pl = pl + 1 |
И запомнили, что заняли еще |
|
|
одну строчку |
|
End If |
|
|
|
|
|
Next I |
|
|
For i = 3 To K + 2 |
|
|
|
|
|
If Cells(i, j) = –1 Then |
|
|
|
|
|
Worksheets("Pri").Cells(strokA + p2, 3) = |
Теперь просматриваем таблицу |
|
Cells(i, 1) |
||
для поиска и заполнения |
||
|
||
p2 = p2 + 1 |
списка отрицательного выбора |
|
|
|
|
End If |
|
|
|
|
|
Next I |
|
|
|
|
|
For i = 3 To K + 2 |
|
|
|
|
|
If Cells(j, i) = 1 Then |
|
|
|
|
|
Worksheets("Pri").Cells(strokA + p3, 4) = |
Поиск и составление списка |
|
Cells(1, i) |
||
тех, кому он нравится |
||
|
||
p3 = p3 + 1 |
||
|
||
|
|
|
End If |
|
|
|
|
|
Next I |
|
|
|
|
|
For i = 3 To K + 2 |
|
|
|
|
|
If Cells(j, i) = –1 Then |
|
|
|
|
|
Worksheets("Pri").Cells(strokA + p4, 5) = |
|
|
ells(1, i) |
... и не нравится |
|
|
||
p4 = p4 + 1 |
|
|
|
|
|
End If |
|
|
|
|
|
Next I |
|
|
|
|
|
|
|
107
3. Проекты на VBA
pm = 0 |
|
|
If pl > p2 Then pm = pl Else pm = p2 |
Смотрим, в какой колонке |
|
If p3 > pm Then pm = p3 |
заняли больше всего строк и |
|
соответственно увеличиваем |
||
If p4 > pm Then pm = p4 |
||
переменную strokA |
||
strokA = strokA + pm |
|
|
Next j |
Переходим к следующему |
|
|
участнику |
|
End Sub |
|
|
|
|
Код для рабочего листа itog
Dim KK As Integer, zz As Integer |
Объявление переменных |
|
Private Sub ComboBox1_Change() |
Процедура срабатывает, если |
|
|
изменился выбор в |
|
|
ComboBox1 |
|
Range("o3:r18").Clear |
Удаляем предыдущие |
|
|
сведения |
|
K = Worksheets(1).Cells(2, 2) |
Считываем общее число |
|
|
участников |
|
j = ComboBox1.Value |
Определяем номер |
|
|
выбранного участника |
|
p1 = 3 |
|
|
For i = 1 To K |
И для выбранного участника |
|
If Worksheets(1).Cells(i + 2, j + 2) = 1 Then |
составляем список его |
|
Cells(p1, 15) = Worksheets(1).Cells(i + 2, 1) |
симпатий, который |
|
|
размещаем на рабочем листе |
|
p1 = p1 + 1 |
||
так, чтобы он попал в |
||
End If |
ComboBox2 |
|
|
|
|
Next |
|
|
p1 = 3 |
|
|
For i = 1 To K |
|
|
|
|
|
If Worksheets(1).Cells(i + 2, j + 2) = –1 |
|
|
Then |
Составляем список его |
|
|
||
Cells(p1, 16) = Worksheets(1).Cells(i + 2, 1) |
антипатий для ComboBox3 |
|
|
|
|
p1 = p1 + 1 |
|
|
End If |
|
|
Next |
|
|
|
|
|
|
|
108
Моделирование физического процесса
p1 = 3 |
|
|
For i = 1 To K |
|
|
If Worksheets(1).Cells(j + 2, i + 2) = 1 Then |
Затем список тех, кто его |
|
Cells(p1, 17) = Worksheets(1).Cells(1, i + 2) |
||
любит |
||
p1 = p1 + 1 |
||
|
||
End If |
|
|
Next |
|
|
'его не любят |
|
|
p1 = 3 |
|
|
For i = 1 To K |
|
|
If Worksheets(1).Cells(j + 2, i + 2) = –1 |
|
|
Then |
...и не любит |
|
Cells(p1, 18) = Worksheets(1).Cells(1, i + 2) |
|
|
p1 = p1 + 1 |
|
|
End If |
|
|
Next |
|
|
End Sub |
|
|
|
|
Моделирование физического процесса
Немного физики и математики
Данный пример наглядно показывает возможности применения VBA в электронной таблице для создания динамических моделей различных природных процессов. Конечно, успешность модели во многом зависит от того, насколько она грамотно составлена с математической точки зрения, сколько параметров влияют на сам процесс и так далее. Но, тем не менее, на этом примере можно понять, каким образом создается именно динамическая модель, ярко иллюстрируется правильный выбор диаграммы, управление ячейками, с которыми связана диаграмма. Кроме того, пример иллюстрирует широту возможностей применения выбранного нами языка программирования. Проект называется «Шарики»
Рассмотрим модель центрального, абсолютно упругого удара двух шариков. Как известно при таком ударе двух тел массой M1 è M2, движущихся соответственно со скоростями V1 è V2 выполняются законы сохранения импульса
109
3. Проекты на VBA
M 1V1 M 2V2 M 1U 1 M 2U 2
и закона сохранения энергии
M V 2 |
|
M V 2 |
|
M U 2 |
|
M U 2 |
||||
1 |
1 |
|
2 |
2 |
|
1 |
1 |
|
2 |
2 |
2 |
|
2 |
|
2 |
|
2 |
|
|||
|
|
|
|
|
|
|
||||
ãäå U1 è U2 – скорости тел после соударения.
Совместное решение двух этих уравнений позволяет определить сначала значение скорости U1
U |
1 |
(M |
1 M 2 )V1 2M |
2V2 |
(1), |
|
M 1 M 2 |
|
|||
|
|
|
|
|
|
а затем и U2 |
|
|
|
|
|
|
U 2 |
V1 U 1 V2 |
|
(2) |
|
Используя эти соотношения, построим модель движения шариков в замкнутом объеме. Эти шарики имеют определенные нача- льные скорости и при соударении друг с другом меняют их в соответствии с вышеприведенными формулами. Для того чтобы соударения происходили многократно, движения шариков ограничены боковыми стенками, при ударе о которые, шарики изменяют свою скорость по направлению, сохраняя ее по величине.
Оформляем рабочий лист
Сначала поработаем в самой электронной таблице и зададим необходимые для вычисления параметры. Здесь целесообразно воспользоваться такой возможностью ЭТ, как имена ячеек. В первой строке, в ячейках А1:D4 соответственно, набираем имена яче- ек, чтобы обозначить массы и начальные скорости каждых из шаров, а именно: mmm1, vvv1, mmm2, vvv2. После этого, выделив блок A1:D4, используем Меню/Вставка/Имя/Создать/В строке ниже и присваиваем ячейкам A2:D2 эти имена. Сразу, чтобы не запутаться в дальнейшем, можно в ячейки А1:D4 ввести пояснения, например «масса1», «скорость1», и т. д. В ячейки второй строки этого блока нужно ввести числовые значения. Массы шариков целесообразно выбрать в диапазоне 1...10 (единицы измерения — килограммы, но это несущественно), а скорости в диапазоне от —10 до +10 (допустим, метров в секунду).
Затем оформим блок E1:F2, где во второй строке введем нача- льные координаты шариков. Будем считать, что расстояние между
110