Автоматический пересчет данных таблицы при изменении ее значений

Листинг 2.17. Переформирование таблицы

Sub Worksheet_Change(ByVal Target As Range)

Dim rgData As Range

Dim cell As Range

Dim dblMax As Double, dblMin As Double, dblAverage As Double

' Получение контролируемого диапазона ячеек

Set rgData = Range(" B2: B11")

' Проверка, не входит ли измененная ячейка в контролируемый _

диапазон

If Not (Application.Intersect(Target, rgData) Is Nothing) Then

If Application.WorksheetFunction.CountA(rgData) > 0 Then

' Изменена ячейка из контролируемого диапазона

' Заново рассчитываем минимальное, максимальное и среднее _

значения в контролируемом диапазоне ячеек

dblMin = Application.WorksheetFunction.Min(rgData)

dblMax = Application.WorksheetFunction.Max(rgData)

dblAverage = Application.WorksheetFunction.Average(rgData)

' Проверяем каждую ячейку из контролируемого диапазона _

и изменяем цвет шрифта ячеек с минимальным и максимальным _

значениями, а также помечаем желтым цветом ячейки _

со значениями больше среднего

For Each cell In rgData

If cell.Value = dblMax Then

' Ячейку с максимальным значением выделим красным цветом

cell.Font.Bold = True

cell.Font.Color = RGB(255, 0, 0)

ElseIf cell.Value = dblMin Then

' Ячейку с минимальным значением выделим синим цветом

cell.Font.Bold = False

cell.Font.Color = RGB(0, 0, 255)

Else

cell.Font.Bold = False

cell.Font.Color = RGB(0, 0, 0)

End If

If cell.Value > dblAverage Then

' Значение в ячейке больше среднего - выделим ее _

желтым цветом

cell.Interior.Color = RGB(255, 255, 0)

Else

cell.Interior.ColorIndex = xlNone

End If

Next

Else

rgData.Interior.ColorIndex = xlNone

End If

End If

End Sub

Ячейка и диапазон

Автоматизация ввода данных в ячейки

Листинг 2.18. Ввод данных в ячейки

Sub SetCellData()

' Заполнение значениями ячеек А3 и В4

Range(" A3") = " Данные для ячейки A3"

Range(" B4") = " Данные для ячейки B4"

End Sub

Листинг 2.19. Ввод данных с использованием формул

Sub SetCellFormula()

' Запись в ячейку А6 формулы " =A5+B5"

Range(" A6") = " =A5+B5"

End Sub

Выделение диапазона над текущей ячейкой

Листинг 2.20. Выделение диапазона над текущей ячейкой

Sub SelectCellRange()

Dim strSelTop As String, strSelBottom As String

' Получение адресов нижней и верхней ячеек диапазона для выделения

strSelBottom = ActiveCell.Address

strSelTop = Cells(1, ActiveCell.Column).Address

' Выделяем все ячейки выше текущей (вместе с текущей ячейкой)

Range(strSelTop & ": " & strSelBottom).Select

End Sub