Знакомиться с программой будем в два этапа: на первом этапе напишем код программы и создадим пользовательские формы, на втором – рассмотрим порядок ее применения.
Создание программы
Итак, для создания программы нужно в модуле 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
' Нахождение максимального значения