Как скопировать некоторый диапазон в цикле в правильном направлении?

Question

Я пытаюсь скопировать некоторый диапазон (таблицу) в правильном направлении, но у меня есть проблема, потому что правильное направление - это символы.Моя функция получает количество копий и количество строк в таблице (диапазон таблицы является динамическим).

Function DrawBorder(Rows As Long, Amount As Long)

    Dim rng As Range
    Dim WS As Worksheet
    Dim firstRow As Long
    Dim firstCol As Long
    Dim lastRow As Long
    Dim lastCol As Long

    Let firstRow = 2
    Let firstCol = 2
    Let lastRow = Rows + 2
    Let lastCol = 4

    Set WS = Sheets("Sheet1")
    Set rng = WS.Range("B" & firstRow & ":" & "D" & lastRow)

    'Borders of the cells inside the range
    rng.Borders.LineStyle = xlContinuous

    'Border of the range as a whole with double lines
    rng.Borders(xlEdgeTop).LineStyle = xlContinuous
    rng.Borders(xlEdgeTop).Weight = xlThick
    rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
    rng.Borders(xlEdgeBottom).Weight = xlThick
    rng.Borders(xlEdgeLeft).LineStyle = xlContinuous
    rng.Borders(xlEdgeLeft).Weight = xlThick
    rng.Borders(xlEdgeRight).LineStyle = xlContinuous
    rng.Borders(xlEdgeRight).Weight = xlThick

   ' Paste to multiple destinations
   rng.Copy Destination:=Sheet1.Range("F" & firstRow & ":" & "H" & lastRow)
   rng.Copy Destination:=Sheet1.Range("J" & firstRow & ":" & "L" & lastRow)
   rng.Copy Destination:=Sheet1.Range("N" & firstRow & ":" & "P" & lastRow)
   rng.Copy Destination:=Sheet1.Range("R" & firstRow & ":" & "T" & lastRow)

End Function

Я хочу сделать это в цикле, но я не знаю, как увеличить назначение столбцов.

Это то, что мне нужно:

Последний цикл, который я использую:

Dim i As Long
For i = 0 To Amount - 1 'copy "Amount" times
    rng.Copy Destination:=rng.Offset(ColumnOffset:=4 * i)
Next i

Спасибо всем!

Answer 1

Вы можете попробовать код ниже. Можно зацикливаться на желаемое количество раз, каждый раз устанавливая правильный диапазон, чтобы нарисовать границу:

Sub DrawBorder()
    'Your input data
    Dim rows As Long: rows = 10
    Dim amount As Long: amount = 10
    'I guess those will be constants
    Dim columns As Long: columns = 2
    Dim firstRow As Long: firstRow = 2
    Dim firstColumn As Long: firstColumn = 2

    Dim rng As Range

    For i = 0 To amount - 1

        Set rng = Range(Cells(firstRow, firstColumn + i * (columns + 2)), Cells(firstRow + rows, firstColumn + columns + i * (columns + 2)))
        'Border of the range as a whole with double lines
        rng.Borders(xlEdgeTop).LineStyle = xlContinuous
        rng.Borders(xlEdgeTop).Weight = xlThick
        rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
        rng.Borders(xlEdgeBottom).Weight = xlThick
        rng.Borders(xlEdgeLeft).LineStyle = xlContinuous
        rng.Borders(xlEdgeLeft).Weight = xlThick
        rng.Borders(xlEdgeRight).LineStyle = xlContinuous
        rng.Borders(xlEdgeRight).Weight = xlThick

    Next
End Sub

Answer 2

Границы рисования

Ссылки

Загрузка рабочей книги

Код

Sub DrawBorders(Rows As Long, Optional Amount As Long = 1, _
        Optional ColumnsInBetween As Long = 1)

    Const cSheet As Variant = "Sheet1"  ' Worksheet Name/Index
    Const firstRow As Long = 2          ' First Row Number
    Const firstCol As Variant = "B"     ' First Column Letter/Number
    Const lastCol As Variant = "D"      ' Last Column Letter/Number
    Const colBetween As Long = 1        ' Columns Between Ranges

    Dim rng As Range        ' Current Range
    Dim noCols As Long      ' Number of Columns
    Dim i As Long           ' Amount Counter
    Dim j As Long           ' Inside Borders Counter

    With ThisWorkbook.Worksheets(cSheet)
        noCols = .Cells(1, lastCol).Column - .Cells(1, firstCol).Column + 1
        For i = 0 To Amount - 1
            Set rng = .Cells(firstRow, .Cells(firstRow, firstCol) _
                    .Column + (noCols + ColumnsInBetween) * i)
                    .Resize(Rows, noCols)
            With rng
                ' Default:  xlContinuous, xlThin, xlColorIndexAutomatic
                .BorderAround , xlThick
                For j = 11 To 12
                    With .Borders(j)
                         .LineStyle = xlContinuous
                    End With
                Next
             End With
         Next
     End With
End Sub

Использование

ДО

Sub DrawExample()

    DrawBorders 20, 6

End Sub

ПОСЛЕ

Answer 3

Используйте цикл в сочетании со свойством Range.Offset для "перемещения" / смещения диапазона.

Приведу один пример:

Dim i As Long
For i = 1 to Amount 'copy "Amount" times
    'your code here

    rng.Copy Destination:=Sheet1.Range("F" & firstRow & ":" & "H" & lastRow).Offset(ColumnOffset:=4 * i))
Next i