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

【问题标题】：How to replicate block of codes in new cells in vba?如何在vba的新单元格中复制代码块？
【发布时间】：2015-05-06 18:44:27
【问题描述】：

我的数据（第 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

【问题讨论】：

没有时间编写示例，但我会尝试使用两个For 循环和Cells 选择范围的方法。
有时间可以提供样品吗？我对如何使用循环不熟悉和困惑。谢谢！
您的号码是否总是适合右边的方格（即 4 的幂）？
每张表是 24 x 16 （从 A 列中取出总共 384 个值，在表中从左到右填充，然后从上到下）总共表是 100。

标签： vba excel offset

【解决方案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

最好的问候，

安倍

【讨论】：