Готовые макросы в vba excel, Миронов Глава Макросы 9

• Название: Готовые макросы в vba excel, Миронов Глава Макросы 9
• Дата: 06.02.2018
• Размер: 1.35 Mb.
• Имя файла: 33980_7d1642e70814394f108d07a8a2edd23e.doc
• Тип: Документы; #35930
• страница: 19 из 47

Быстрое заполнение диапазона (массив)

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

Заполнение через интервал(массив)

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

Заполнение указанного диапазона(массив)

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

Заполнение диапазона(массив)

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.65. Функция dhNSum

Function dhNSum(ByVal intCount As Integer, _

rgValues As Range) As Double

Dim i As Integer

Dim dblSum As Double

If intCount > rgValues.Count Then

' Задано количество элементов большее, чем есть _

в переданном диапазоне

intCount = rgValues.Count

End If

' Расчет суммы первых intCount элементов

For i = 1 To intCount

dblSum = dblSum + rgValues(i)

Next i

' Возврат результата

dhNSum = dblSum

End Function