vba - 复制单元格 "n"次。 "n"是用户指定的

Question

我正在尝试编写一个宏，该宏将查看一张表中的数字用户输入，并将在另一张表中复制该次数的内容。

例如，我想将公司名称和 ID 复制“n”次。 “n”在同一行的最后一列中指定。

表 1

company name | company ID | number of items purchased here
----------------------------------------------
blue company |  999       | 2
rose company |  444       | 1
gold company |  222       | 3

表 2

company name | company ID
---------------------------
blue company | 999
blue company | 999
rose company | 444
gold company | 222
gold company | 222
gold company | 222

这段代码做了类似的事情，但是为锄头多次选择复制某些东西的范围总是设置为“C2”中的任何内容。

Sub rangecopy()
    Dim source As Worksheet
    Dim destination As Worksheet
    Dim i As Integer, n As Integer
    Dim intHowmany As Integer

    Set source = Sheets("Sheet1")
    Set destination = Sheets("Sheet3")
    n = Sheets("Sheet1").Range("c2") 'number of times to be copied

    Range("a2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, (Selection.Offset(0, 1))).Select

    Selection.Copy

    intHowmany = Selection.Rows.Count

    destination.Select
    Range("a2").Select

    For i = 1 To n
        ActiveSheet.Paste
        ActiveCell.Offset(intHowmany, 0).Select
    Next i
End Sub

Answer 1

不是很优雅，但工作正常，可以很容易地改变。

Sub rangecopy()
    Dim source As Worksheet
    Dim destination As Worksheet
    Dim i As Integer, n As Integer
    Dim intHowmany As Integer

    Set source = Sheets("Sheet1")
    Set destination = Sheets("Sheet2")
    destination.Cells(1, 1).Value = "Company"
    destination.Cells(1, 2).Value = "ID"
    startRow = 2
    usedRowsSrc = source.UsedRange.Rows.Count
    For i = startRow To usedRowsSrc
      strCompany = source.Cells(i, 1).Value
      strID = source.Cells(i, 2).Value
      iTimes = source.Cells(i, 3).Value

      For j = 1 To iTimes
        usedRowsDest = destination.UsedRange.Rows.Count
        With destination
          .Cells(usedRowsDest + 1, 1).Value = strCompany
          .Cells(usedRowsDest + 1, 2).Value = strID
        End With
      Next

    Next

End Sub