excel - 如何将循环中的某些范围复制到正确的方向？

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

结合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

Answer 2

你可以试试下面的代码。循环所需的次数就足够了，每次设置适当的范围以绘制边框：

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 3

绘制边框

链接

工作簿下载

编码

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

后