列出在两个单元格中指定范围的范围内的所有数字 - vba

Question

我有excel表，其中包含以下数据：

col1      col2    col3    col4
dvdtable    6      52      57
tvunit      2      30      31

我需要复制另一张纸中的每一行，但是要制作6份dvdtable行和2份tvunit行。 （col2指的是数量）。另外，我需要创建一个新列，其中对于6个dvdtable行中的每一行，我在新列中分别包含52,53,54,55,56,57。请参阅以下结果：

col1      col2    col3 
dvdtable    6      52
dvdtable    6      53
dvdtable    6      54
dvdtable    6      55
dvdtable    6      56
dvdtable    6      57
tvunit      2      30
tvunit      2      31

由于论坛中的另一个问题，我设法生成了创建行的多个副本的代码，但我仍然坚持编程的最后一部分，我需要在列中给出的范围内创建数字列表每种家具都有3和4栏。

Answer 1

您可能需要更改工作表名称。

Option Explicit
Sub whyDidIDoThisForYou()

    Dim i, j, k As Integer
    Dim numbRows As Integer
    Dim curWriteRow As Integer
    Dim temp As Integer
    Dim values() As String

    numbRows = Range("a1").End(xlDown).Row - 1 'assumes heading
    curWriteRow = 1
    ReDim values(1 To numbRows, 1 To 4)

    For i = 1 To numbRows

        'read all values in from initial datasheet
        For j = 1 To 4
            values(numbRows, j) = Sheets("Sheet1").Cells(i + 1, j).Value
        Next j

        'write to next sheet
        'get number of things to write
        temp = values(numbRows, 4) - values(numbRows, 3)

        'start writing the "output" sheet!
        For j = 0 To temp
               Sheets("Sheet2").Cells(curWriteRow, 1).Value = values(numbRows, 1)
               Sheets("Sheet2").Cells(curWriteRow, 2).Value = values(numbRows, 2)
               Sheets("Sheet2").Cells(curWriteRow, 3).Value = values(numbRows, 3) + j
               curWriteRow = curWriteRow + 1
        Next j

    Next i

End Sub

Answer 2

您可以使用如下所示的数组，这比按单元格逐行写入范围要快得多

以下代码

• 将原始数据读入变体数组Y
• 循环遍历Y（lngCnt2）
的每一行
• 按照colulmB（Y）中指定的次数运行lngCnt3
• 将新记录转储到第二个变体数组X
• 将x转储到完成后以E1开头的范围

Sub SplicenDice()
Dim rng1 As Range
Dim lngCnt As Long
Dim lngCnt2 As Long
Dim lngCnt3 As Long
Dim lngCnt4 As Long
Dim X
Dim Y
Set rng1 = Range([a1], Cells(Rows.Count, "D").End(xlUp))
Y = rng1.Value2
lngCnt = Application.WorksheetFunction.Sum(Range("B:B"))
ReDim X(1 To lngCnt, 1 To 3)
For lngCnt2 = 1 To UBound(Y, 1)
For lngCnt3 = 1 To Y(lngCnt2, 2)
lngCnt4 = lngCnt4 + 1
X(lngCnt4, 1) = Y(lngCnt2, 1)
X(lngCnt4, 2) = Y(lngCnt2, 2)
X(lngCnt4, 3) = Y(lngCnt2, 3) + lngCnt3 - 1
Next
Next
[e1].Resize(UBound(X, 1), UBound(X, 2)).Value2 = X
End Sub