2

我有一个包含以下数据的

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

我需要将每一行复制到另一张纸上，但是制作 dvdtable 行的 6 个副本和 tvunit 行的 2 个副本。（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 列和第 3 列中给出的范围内创建数字列表每种家具4个。

4

2 回答 2

2

您可能必须更改工作表名称。

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
于 2012-09-11T17:07:53.760 回答
0

您可以使用如下数组，这比逐个单元格地写入范围要快得多

下面的代码

  • 将原始数据读入变量数组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
于 2012-09-12T00:01:28.567 回答