Алексей Гладкий - Excel. Трюки и эффекты

Так как для хранения данных у нас используется таблица, то элементы дерева хранятся в следующем виде. Значение элемента дерева (текст вопроса или название животного) содержится в столбце А. Для узла (то есть вопроса) в столбце В содержится номер строки, на которую следует перейти при утвердительном ответе, а в столбце С – номер строки, на которую необходимо перейти при отрицательном ответе на вопрос. Для листа (названия животного) столбцы В и С пусты.

Кроме того, в ячейке D1 хранится номер первой строки, которая может быть использована для вставки новых данных. Заодно этот номер применяется для предотвращения ошибок программы (зацикливания и прочих неприятностей) при повреждении данных.

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

Знакомиться с программой будем в два этапа: на первом этапе напишем код программы и создадим пользовательские формы, на втором – рассмотрим порядок ее применения.

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

Программный код в стандартном модуле VBA выглядит следующим образом (листинг 5.5).

Const dhcSum As Integer = 0

Const dhcAvg As Integer = 1

Const dhcMax As Integer = 2

Const dhcMin As Integer = 3

Const dhcCount As Integer = 4

Const dhcSumPlus As Integer = 5

Const dhcSumMinus As Integer = 6

Const dhcCountFull As Integer = 7

Const dhcCountNotNull As Integer = 8

Const dhcCountPlus As Integer = 9

Const dhcCountMinus As Integer = 10

Sub CalcColors()

' Отображение формы

Load frmColorCalc

frmColorCalc.Show

End Sub

Public Function ColorCalc(strRange As String, _

lngColor As Long, fBackBolor As Boolean, _

intMode As Integer, Optional fAbsence As Boolean) As Double

' Операции над ячейками с установленным цветом шрифта _

или заливки

Dim rgData As Range ' Диапазон ячеек для расчетов

Dim i As Integer

Dim Values() As Variant ' Массив со значениями для расчета

Dim intCount As Integer ' Количество значений в массиве

Dim cell As Range

Dim varOut As Variant ' В этой переменной хранятся _

результаты промежуточных подсчетов _ и окончательный результат

Set rgData = Range(strRange)

ReDim Values(1 To rgData.Count)

' Просматриваются все ячейки входного диапазона. Значения

тех из них, _

цвет которых удовлетворяет условию, записываются в массив

Values

For Each cell In rgData.Cells

' Если нужно суммировать по заливке:

If fBackBolor = True Then

' Включение ячейки в сумму в зависимости от цвета _

заливки и фильтра

If fAbsence Then

' Если ячейка имеет заданный цвет, то она не включается _

в вычисления

If cell.Interior.Color <> lngColor Then

intCount = intCount + 1

Values(intCount) = cell.Value

End If

Else

' Если ячейка имеет заданный цвет, то она включается _

в вычисления

If cell.Interior.Color = lngColor Then

intCount = intCount + 1

Values(intCount) = cell.Value

End If

End If

' В противном случае – суммируется по шрифту

Else

' Включение ячейки в сумму в зависимости _

от ее цвета и фильтра

If fAbsence Then

' Если ячейка имеет заданный цвет, то она не включается _

в вычисления

If cell.Font.Color <> lngColor Then

intCount = intCount + 1

Values(intCount) = cell.Value

End If

Else

' Если ячейка имеет заданный цвет, то она включается _

в вычисления

If cell.Font.Color = lngColor Then

intCount = intCount + 1

Values(intCount) = cell.Value

End If

End If

End If

Next cell

' Выполнение над собранными значениями операции, заданной

в intMode

For i = 1 To intCount

Select Case intMode

Case dhcSum, dhcAvg

' Подсчет суммы значений

varOut = varOut + Values(i)

Case dhcSumPlus

' Подсчет суммы положительных значений

If Values(i) > 0 Then varOut = varOut + Values(i)

Case dhcSumMinus

' Посчет суммы отрицательных значений

If Values(i) < 0 Then varOut = varOut + Values(i)

Case dhcMax

' Нахождение максимального значения

If Values(i) > varOut Then varOut = Values(i)

Case dhcMin

' Нахождение минимального значения

If i = LBound(Values) Then varOut = Values(i)

If Values(i) < varOut Then varOut = Values(i)

Case dhcCount

' Подсчет количества значений

varOut = varOut + 1

Case dhcCountFull

' Подсчет количества заполненных ячеек

If Not IsEmpty(Values(i)) Then varOut = varOut + 1

Case dhcCountNotNull

' Подсчет количества пустых ячеек