Excel. Трюки и эффекты | страница 146



Как известно, расчет среднего значения можно выполнять штатными средствами Excel – с помощью функции СРЗНАЧ. Однако в некоторых случаях удобнее воспользоваться макросом, код которого представлен в листинге 3.100 (этот код нужно набрать в стандартном модуле редактора VBA).

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

Sub CalculateAverage()

Dim strFistCell As String

Dim strLastCell As String

Dim strFormula As String

' Условия закрытия процедуры

If ActiveCell.Row = 1 Then Exit Sub

' Определение положения первой и последней ячеек для расчета

strFistCell = ActiveCell.Offset(-1, 0).End(xlUp).Address

strLastCell = ActiveCell.Offset(-1, 0).Address

' Формула для расчета среднего значения

strFormula = "=AVERAGE(" & strFistCell & ":" & strLastCell &

")"

' Ввод формулы в текущую ячейку

ActiveCell.Formula = strFormula

End Sub

В результате выполнения данного макроса в активной ячейке отобразится среднее арифметическое, рассчитанное на основании расположенных выше непустых ячеек; при этом ячейки с данными должны следовать одна за другой, без пробелов. Иначе говоря, если активна ячейка А5, а над ней все ячейки содержат данные, кроме ячейки А2, то среднее арифметическое будет рассчитано на основании данных ячеек A3 и А4 (ячейка А1 в расчете участвовать не будет). Если же пустой является только ячейка А4, то среднее арифметическое в ячейке А5 рассчитано не будет.

Вывод списка доступных шрифтов

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

Листинг 3.101. Список шрифтов

Sub ListOfFonts()

Dim cbrcFonts As CommandBarControl

Dim cbrBar As CommandBar

Dim i As Integer

' Получение доступа к списку шрифтов (элемент управления в виде _

раскрывающегося списка на панели инструментов «Форматирование»)

Set cbrcFonts = Application.CommandBars(«Formatting»). _

FindControl(ID:=1728)

If cbrcFonts Is Nothing Then

' Панель «Форматирование» не открыта – откроем ее

Set cbrBar = Application.CommandBars.Add

Set cbrcFonts = cbrBar.Controls.Add(ID:=1728)

End If

' Подготовка к выводу шрифтов (очистка ячеек)

Range(«A:A»).ClearContents

' Вывод списка шрифтов в столбец "A" текущего листа

For i = 0 To cbrcFonts.ListCount – 1

Cells(i + 1, 1) = cbrcFonts.List(i + 1)

Next i

' Закрытие панели инструментов «Форматирование», если мы были _

вынуждены ее открывать

On Error Resume Next

cbrBar.Delete

End Sub

В результате работы данного макроса перечень доступных шрифтов будет сформирован на активном рабочем листе в столбце А. После этого список шрифтов можно по обычным правилам вывести на печать.