如何复制4个独立数据元素的索引范围

Question

我使用索引循环遍历另一个工作表中的非空白记录，并从中提取2个值，这很好。现在，我需要复制这些行，以便每一行出现4次，第3列包含4个公司名称(Company1、Commpany2、Company3和Company4)。因此，我们的结果是作为源表的记录数的4倍，如下所示：

​

​

我目前的代码是：

Sub Address_Raw()
    Dim dataBook As Workbook
    Dim Address_Raw As Worksheet, Del_Tax As Worksheet
    Dim dataSource As Range, dataDest As Range
    Dim sourceDataRowCount As Integer, index As Integer

    Set dataBook = Application.ThisWorkbook
    Set sheetSource = dataBook.Sheets("Address_Raw")
    Set sheetDest = dataBook.Sheets("Del_Tax")

    Set dataSource = sheetSource.Range("B4", _
                    sheetSource.Range("B90000").End(xlUp))
    sourceDataRowCount = dataSource.Rows.Count

    Set dataDest = sheetDest.Range("B13", "B" & _
                                sourceDataRowCount)

    For index = 1 To sourceDataRowCount
      dataDest(index, 1).Value = dataSource(index, 1).Value
      dataDest(index, 2).Value = dataSource(index, 2).Value

    Next index

End Sub

Answer 1

您必须在for循环中添加一个内循环。像这样的东西(未经测试)：

destIndex = 1
For index = 1 To sourceDataRowCount
   For j = 1 to 4
     dataDest(destIndex, 1).Value = dataSource(index, 1).Value
     dataDest(destIndex, 2).Value = dataSource(index, j + 1).Value
     destIndex = destIndex + 1
   Next j
Next index