使用VBA以特定方式动态添加范围

Question

我想使用类似于发布的图像的 excel/vba 创建一个表。

下面是我的代码。

Dim nextRowAs Range
For i = 1 To N
  
    Set nextRow= ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1, 0)
    nextRow.PasteSpecial xlPasteAll
    Set nextRow1= ws.Cells(ws.Rows.Count, "B").End(xlUp).Offset(-3, 0)
     nextRow.Value = 0
      Set nextRow2= ws.Cells(ws.Rows.Count, "B").End(xlUp).Offset(-2, 0)
     nextRow2.Value = 0
      Set nextRow3= ws.Cells(ws.Rows.Count, "B").End(xlUp).Offset(-1, 0)
     nextRow3.Value = 0

我将第 1 部分定义为命名范围，并将其复制并粘贴到底部，将用户输入清除为 I go。

我需要什么指导。

1. 此代码将每个范围粘贴到底部。 我想像图片一样粘贴它，先从左到右，然后从上到下，每行 2 个。

Answer 1

像这样 - 可能看起来有点复杂，但最好将代码分解为模块化部分：

Sub Tester()
    Dim n As Long
    For n = 1 To 10
        CreateArea n
    Next n
End Sub

Sub CreateArea(areaNum As Long)
    With AreaRange(areaNum)
        AreaRange(1).Copy .Cells(1)
        .Cells(1, 1).Value = areaNum
        ResetArea .Cells
    End With
End Sub

Sub ResetArea(rngArea As Range)
    rngArea.Cells(2, 2).Resize(3, 1).ClearContents
End Sub

'return the range for supplied area number
Function AreaRange(areaNum As Long) As Range
    Const RNG1 As String = "E2:F6" 'first area
    Const PER_ROW As Long = 2      'two blocks per row
    Dim r1 As Range, rwOff As Long, colOff As Long, c As Range
    Set r1 = ActiveSheet.Range(RNG1) 'or set a specific sheet
    'calculate offsets for the area to be created (adding 1 empy row/column between areas)
    rwOff = Application.Floor((areaNum - 1) / PER_ROW, 1) * (r1.Rows.Count + 1)
    colOff = ((areaNum - 1) Mod PER_ROW) * (r1.Columns.Count + 1)
    Set AreaRange = r1.Offset(rwOff, colOff) 'return the offset range
End Function