如何在vba中复制新单元格中的代码块？

Question

我的数据（数字1到数字24）在A列中。我想以下面显示的方式创建6个表来包含我的数据。我已经为第一张表创建了代码。对剩下的5个表进行编码的最佳方法是什么？我的实际产品是一个更大的表，需要复制100次，因此不可能进行硬编码。 （将抵消财产帮助？如何？）

这是第一张表的代码。

Sub DataToTable()

Range("C1:E3").Borders.LineStyle = xlContinuous
Range("C:M").ColumnWidth = 4.67
Range("C1:E1").Interior.ColorIndex = 27
Range("C2:C3").Interior.ColorIndex = 27

Range("D2").Value = Range("A1")
Range("E2").Value = Range("A2")
Range("D3").Value = Range("A3")
Range("E3").Value = Range("A4")

End Sub

Answer 1

要完成此任务，您必须使用循环。我将与您分享一个工作样本，其中包含允许您为表设置参数的变量，还显示命​​令For的示例以及命令While的一个示例。如果您对代码的某些特定部分有任何疑问，请不要犹豫。

Sub DataToTable()

Dim actualDataRow As Long
Dim tablesPerRow As Integer
Dim actualRowTable As Integer
Dim actualRow As Integer
Dim initialTableRow As Integer
Dim initialTableColumn As Integer

tablesPerRow = 3
actualRow = 0
actualRowTable = 0

initialTableRow = 2
initialTableColumn = 4

actualDataRow = 1

'Style columns (outside for)
Range(Columns(initialTableColumn), Columns(initialTableColumn + (tablesPerRow * 4))).ColumnWidth = 4.67

While Not IsEmpty(Cells(actualDataRow, 1))

    'Style table
    Range(Cells(initialTableRow + (actualRow * 4) - 1, initialTableColumn + (actualRowTable * 4) - 1), Cells(initialTableRow + (actualRow * 4) + 1, initialTableColumn + (actualRowTable * 4) + 1)).Borders.LineStyle = xlContinuous
    Range(Cells(initialTableRow + (actualRow * 4) - 1, initialTableColumn + (actualRowTable * 4) - 1), Cells(initialTableRow + (actualRow * 4) - 1, initialTableColumn + (actualRowTable * 4) + 1)).Interior.ColorIndex = 27
    Range(Cells(initialTableRow + (actualRow * 4) - 1, initialTableColumn + (actualRowTable * 4) - 1), Cells(initialTableRow + (actualRow * 4) + 1, initialTableColumn + (actualRowTable * 4) - 1)).Interior.ColorIndex = 27

    'Insert table data
    For x = 0 To 1
        For y = 0 To 1
            Cells(initialTableRow + (actualRow * 4) + x, initialTableColumn + (actualRowTable * 4) + y) = Cells(actualDataRow, 1)
            actualDataRow = actualDataRow + 1
        Next y
    Next x
    If actualRowTable >= tablesPerRow - 1 Then
        actualRowTable = 0
        actualRow = actualRow + 1
    Else
        actualRowTable = actualRowTable + 1
    End If

Wend

End Sub

致以最诚挚的问候，

安倍