Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
VBA в примерах .doc
Скачиваний:
113
Добавлен:
03.05.2015
Размер:
1.33 Mб
Скачать

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

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

Листинг 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.Выделение диапазона над текущей ячейкой

SubSelectCellRange()

Dim strSelTop As String, strSelBottom As String

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

strSelBottom = ActiveCell.Address

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

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

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

End Sub

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

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

SubFindEmptyCell()

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

Do While Not IsEmpty(ActiveCell.Value)

ActiveCell.Offset(1, 0).Select

Loop

End Sub

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

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

SubFindMaxValue()

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"Максимальное значение не найдено"

EndSub

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

Листинг 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 ' Начальное значение

DimintStepAsInteger' Шаг при изменении значения

DimintEndValAsInteger' Конечное значение

DimintValAsInteger' Текущее значение

DimintCellOffsetAsInteger' Смещение от начальной ячейки

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

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. Заполнение через интервал

SubFillCells()

DimintStartValAsInteger' Начальное значение

DimintStepAsInteger' Шаг при изменении значения

DimintEndValAsInteger' Конечное значение

DimintValAsInteger' Текущее значение

DimintCellOffsetAsInteger' Смещение от начальной ячейки

DimintCellStepAsInteger' Шаг при перемещении между _

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

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

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

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]