Функция получения повторяющегося диапазона ячеек

Представим, что нам поставлена задача покрасить каждую 10-ю строку таблицы в серый цвет, начиная с пятой строки (таблица занимает 60 строк)

Проще всего (да и быстрее) это сделать при помощи функции RepeatRange:

Sub Пример1()
    RepeatRange(Rows(5), 6, 10, xlDown).Interior.ColorIndex = 15
End Sub

Или другая подобная задача: получить ссылку на диапазон, состоящий из 4 блоков размером 8*3, располагающихся горизонтально со смещением 5 столбцов, и потом нарисовать рамки вокруг этих ячеек.
Тут также поможет функция RepeatRange:

Sub Пример2()
    RepeatRange([a2:c9], 4, 5, xlToRight).Borders.LineStyle = xlContinuous
End Sub

Пример - в прикреплённом к статье файле.

Ещё один случай, когда эта функция позволит заметно увеличить производительность кода VBA, - это если надо изменить высоту множества строк на листе, причем строки, раполагающиеся на равном расстоянии друг от друга, должны иметь одинаковую высоту.

Код функции RepeatRange:

Function RepeatRange(ByRef SourceRange As Range, ByVal Count As Long, _
                     ByVal Offset As Long, ByVal Direction As XlDirection) As Range
    ' функция получает в качестве параметра диапазон SourceRange,
    ' количество повторений диапазона Count, и шаг смещения Offset
    ' Возвращает диапазон, являющийся объединением копий диапазона SourceRange,
    ' смещённого на Offset ячеек Count раз в направлении Direction.

    Select Case Direction
        Case xlDown: OffsetX = 0: OffsetY = Offset
        Case xlUp: OffsetX = 0: OffsetY = -Offset
        Case xlToRight: OffsetX = Offset: OffsetY = 0
        Case xlToLeft: OffsetX = -Offset: OffsetY = 0
    End Select
 
    Set RepeatRange = SourceRange
    For i = 1 To Count - 1
        Set RepeatRange = Union(RepeatRange, SourceRange.Offset(OffsetY * i, OffsetX * i))
    Next i
End Function

Те же примеры использования функции, но с комментариями:

Sub ПервыйПримерИспользованияФункцииRepeatRange()
    ' задача - покрасить каждую 10-ю строку в серый цвет,
    ' начиная с пятой (таблица занимает 60 строк)

    Dim НачальнаяСтрока As Range, ПовторяющиесяСтроки As Range
    Set НачальнаяСтрока = Rows(5)
 
    Set ПовторяющиесяСтроки = RepeatRange(НачальнаяСтрока, 6, 10, xlDown)
    Debug.Print "адрес исходного диапазона: " & НачальнаяСтрока.Address
    ' результат: адрес исходного диапазона: $5:$5
    ' (пятая строка активного листа)

    Debug.Print "адрес конечного диапазона: " & ПовторяющиесяСтроки.Address
    ' результат: адрес конечного диапазона: $5:$5,$15:$15,$25:$25,$35:$35,$45:$45,$55:$55
    ' (диапазон, состоящий из строк 5, 15, 25, 35, 45, 55, - итого 6 повторений с шагом 10)
    
    ПовторяющиесяСтроки.Interior.ColorIndex = 15 ' красим строки в серый цвет
End Sub
 
Sub ВторойПримерИспользованияФункцииRepeatRange()
    ' задача - получить ссылку на диапазон, состоящий из 4 блоков размером 8*3
    ' располагающихся горизонтально со смещением 5 столбцов
    ' и потом нарисовать рамки вокруг этих ячеек

    Dim ra1 As Range, ra2 As Range
    Set ra1 = [a2:c9]
 
    Set ra2 = RepeatRange(ra1, 4, 5, xlToRight)
    Debug.Print "адрес исходного диапазона: " & ra1.Address
    ' результат: адрес исходного диапазона: $A$2:$C$9

    Debug.Print "адрес конечного диапазона: " & ra2.Address
    ' результат: адрес конечного диапазона: $A$2:$C$9,$F$2:$H$9,$K$2:$M$9,$P$2:$R$9
    
    ra2.Borders.LineStyle = xlContinuous ' рисуем рамки вокруг ячеек
End Sub

Вложения:

RepeatRange.xls

31 КБ

10487 просмотров

Функция получения повторяющегося диапазона ячеек

Комментарии

Отправить комментарий

НАДСТРОЙКИ ДЛЯ EXCEL