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

Листинг 2.59. Подсчет количества видимых ячеек

Function dhCountVisibleCells(rgRange As Range)

Dim lngCount As Long

Dim cell As Range

' Проходим по всему диапазону и подсчитываем непустые _

видимые ячейки

For Each cell In rgRange

' Проверка, есть ли данные в ячейке

If Not IsEmpty(cell) Then

' Проверка, видима ли ячейка

If Not cell.EntireRow.Hidden And Not _

cell.EntireColumn.Hidden Then

' Еще одна видимая ячейка

lngCount = lngCount + 1

End If

End If

Next cell

dhCountVisibleCells = lngCount

End Function

Поиск ближайшего понедельника

Листинг 2.60. Ближайший день недели по отношению к дате

Function dhGetNextMonday(datDate As Date) As Date

' Определение даты следующего понедельника (функция Weekday _

возвращает номер дня недели, считая от понедельника, если _

в качестве второго аргумента задавать vbMonday)

If Weekday(datDate, vbMonday) = 1 Then

' Заданная дата и есть понедельник

dhGetNextMonday = datDate

Else

' Расчет даты следующего понедельника

dhGetNextMonday = datDate + 8 - Weekday(datDate, vbMonday)

End If

End Function

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

Листинг 2.61. Функция dhCalculateAge

Function dhCalculateAge(datDate As Date) As Long

Dim lngAge As Long

' Находим разность между текущей датой и указанной (лет)

lngAge = DateDiff(" yyyy", datDate, Date)

If DateSerial(Year(datDate) + lngAge, Month(datDate), _

Day(datDate)) > Date Then

' В этом году день рождения еще не наступил

lngAge = lngAge - 1

End If

dhCalculateAge = lngAge

End Function

Проверка, была ли сохранена рабочая книга

Листинг 2.62. Функция dhBookIsSaved

Function dhBookIsSaved() As Boolean

' Если путь файла рабочей книги не задан, то она _

не сохранена (ThisWorkbook.path равняется " ")

dhBookIsSaved = ThisWorkbook.path < > " "

End Function

Расчет средневзвешенного значения

Листинг 2.63. Расчет средневзвешенного значения

Function dhAverageWithWeight(rgWeights As Range, rgValues As Range) _

As Double

If (rgWeights.Count < > rgValues.Count) Then

' Количество весов не соответствует количеству аргументов

dhAverageWithWeight = 0

Exit Function

End If

Dim i As Integer

Dim dblSum As Double ' Сумма значений

Dim dblSumWeight As Double ' Взвешенная сумма значений

' Вычисление...

For i = 1 To rgWeights.Count

' Взвешенной суммы значений

dblSumWeight = dblSumWeight + rgWeights(i) * rgValues(i)

' Суммы значений

dblSum = dblSum + rgWeights(i)

Next

' Возвращение средневзвешенного значения

dhAverageWithWeight = dblSumWeight / dblSum

End Function