Первый способ

Быстрое заполнение диапазона

Автоматическая замена значений диапазона

Поиск максимального значения в диапазоне

Поиск ближайшей пустой ячейки столбца

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

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

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

Листинг 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

Листинг 2.21. Поиск ближайшей пустой ячейки столбца

Sub FindEmptyCell()

' Поиск ближайшей пустой ячейки в текущем столбце

Do While Not IsEmpty(ActiveCell.Value)

ActiveCell.Offset(1, 0).Select

Loop

End Sub

Листинг 2.22. Поиск максимального значения

Sub FindMaxValue()

On Error Goto NoCell

If Selection.Count > 1 Then

' Поиск максимального значения в выделенных ячейках

Selection.Find(Application.Max(Selection)).Select

Else

' Поиск максимального значения во всех ячейках листа

ActiveSheet.Cells.Find(Application.Max(ActiveSheet.Cells)).Select

End If

Exit Sub

NoCell:

MsgBox "Максимальное значение не найдено"

End Sub

Листинг 2.23. Автоматическая замена значений

Sub ReplaceValues()

Dim cell As Range

' Проверка каждой ячейки диапазона на возможность замены _

значения в ней (отрицательные значения заменяются на -1, _

положительные - на 1)

For Each cell In Range("C1:C3").Cells

If cell.Value < 0 Then

cell.Value = -1

ElseIf cell.Value > 0 Then

cell.Value = 1

End If

Next

End Sub

Листинг 2.24. Быстрое заполнение диапазона

Sub FillCells()

Dim intStartVal As Integer ' Начальное значение

Dim intStep As Integer ' Шаг при изменении значения

Dim intEndVal As Integer ' Конечное значение

Dim intVal As Integer ' Текущее значение

Dim intCellOffset As Integer ' Смещение от начальной ячейки

' Установка параметров заполнения

intStartVal = 1

intStep = 1

intEndVal = 100

' Заполнение ячеек текущего столбца значениями от 1 до 100

For intVal = intStartVal To intEndVal Step intStep

ActiveCell.Offset(intCellOffset, 0).Value = intVal

intCellOffset = intCellOffset + 1

Next intVal

End Sub

Листинг 2.25. Заполнение через интервал

Sub FillCells()

Dim intStartVal As Integer ' Начальное значение

Dim intStep As Integer ' Шаг при изменении значения

Dim intEndVal As Integer ' Конечное значение

Dim intVal As Integer ' Текущее значение

Dim intCellOffset As Integer ' Смещение от начальной ячейки

Dim intCellStep As Integer ' Шаг при перемещении между _

заполняемыми ячейками

' Установка параметров заполнения

intStartVal = 3

intStep = 3

intEndVal = 30

intCellStep = 3

' Заполнение ячеек текущего столбца значениями от 3 до 30

For intVal = intStartVal To intEndVal Step intStep

ActiveCell.Offset(intCellOffset, 0).Value = intVal

intCellOffset = intCellOffset + intCellStep

Next intVal

End Sub

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