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

我有一个Excel表格，其中包含以下数据：

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

我需要复制另一张表中的每一行，但是要制作6份dvdtable行和2份tvunit行。 （col2是指数量）。 此外，我需要创build一个新的列，其中每个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列和列给出的范围内创build数字列表4每种types的家具。

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（ lngCnt3 ）中指定的次数遍历Y
• 将新logging转储到第二个变体数组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