Поиск в диапазоне значения по шаблону

Поиск данных в диапазоне

Помещение в ячейку электронных часов

Третий способ

Второй способ

Листинг 2.26. Заполнение указанного диапазона

Sub FillCellRect()

Dim lngRows As Long, intCols As Integer ' Количество ячеек по _

горизонтали и вертикали

Dim lngRow As Long, intCol As Integer ' Координаты текущей ячейки

Dim lngStep As Long, lngVal As Long

' Установка начального значения и шага заполнения

lngVal = 1

lngStep = 1

' Ввод количества ячеек по горизонтали и вертикали, которое _

необходимо заполнить

lngRows = Val(InputBox("Количество ячеек в высоту"))

intCols = Val(InputBox("Количество ячеек в ширину"))

' Отключение обновления экрана

Application.ScreenUpdating = False

' Заполнение ячеек значениями

For lngRow = 1 To lngRows

For intCol = 1 To intCols

ActiveCell.Offset(lngRow, intCol).Value = lngVal

lngVal = lngVal + lngStep

Next intCol

Next lngRow

' Включение обновления экрана

Application.ScreenUpdating = True

End Sub

Листинг 2.27. Заполнение диапазона

Sub FillCellRect1()

Dim lngRows As Long, intCols As Integer

Dim lngRow As Long, intCol As Integer

Dim lngStep As Long, lngVal As Long

Dim alngValues() As Long

Dim rgRange As Range

' Установка начального значения и шага заполнения

lngVal = 1

lngStep = 1

' Ввод количества ячеек по горизонтали и вертикали, которое _

необходимо заполнить

lngRows = Val(InputBox("Количество ячеек в высоту"))

intCols = Val(InputBox("Количество ячеек в ширину"))

ReDim alngValues(1 To lngRows, 1 To intCols)

Set rgRange = ActiveCell.Range(Cells(1, 1), _

Cells(lngRows, intCols))

' Заполнение массива alngValues значениями

For lngRow = 1 To lngRows

For intCol = 1 To intCols

alngValues(lngRow, intCol) = lngVal

lngVal = lngVal + lngStep

Next intCol

Next lngRow

' Перенос значений из массива в таблицу

rgRange.Value = alngValues

End Sub

Листинг 2.28. Размещение в ячейке электронных часов

Sub UpdateTime()

Dim varNextCall As Variant

' Записываем в ячейку текущее время

Cells(1, 1).Value = Now

' Записываем в varNextCall время, когда вызвать этот макрос _

в следующий раз (через 1 секунду)

varNextCall = TimeSerial(Hour(Now), Minute(Now), Second(Now) + 1)

' Уведомляем Excel в необходимости вызова макроса

Application.OnTime varNextCall, "UpdateTime"

End Sub

«Будильник»

Листинг 2.29. «Будильник»

Sub Clock()

' Уведомляем Excel, что процедуру Alarm нужно вызвать в 20:55

Application.OnTime TimeValue("20:55:00"), "Alarm"

End Sub

Sub Alarm()

MsgBox "Пора ужинать!!!"

End Sub

Листинг 2.30. Поиск и замена по шаблону

Sub ReplaceCellsData()

Dim cell As Range

' Просмотр всех ячеек диапазона G1:K20 и замена искомого текста

For Each cell In [G1:K20]

If cell.Value Like "*Доход*" Then

cell.Value = "Выручка"

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

Else

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

End If

Next

End Sub

Дата добавления: 2015-06-25