Excel vba宏根据单元格整数值多次复制行答案

【问题标题】：Excel vba macro copy rows multiple times based on a cell integer valueExcel vba宏根据单元格整数值多次复制行
【发布时间】：2012-07-16 11:41:29
【问题描述】：

我正在寻找将完整行复制到另一个工作表的 VBA Excel 宏。它需要根据单元格整数值创建该行的其他重复副本。

这在使用邮件合并来创建文档或标签的多个副本时很有帮助。我找到了几个很接近的答案，但没有任何复制完整行的答案

输入
col1 | col2 | col3 | col4
狗| 高分辨率照片| CLIPARTO喜欢 |猫 | 1
老鼠| 高分辨率照片| CLIPARTO喜欢 |坚果| 3
猫 |咀嚼 |老鼠| 高分辨率照片| CLIPARTO 2

输出 col4 中的值可能存在，对我来说无关紧要

【问题讨论】：

标签： excel vba duplicates row

【解决方案1】：

假设带有数据的工作表名称为“Sheet1”，输出工作表的名称为“Sheet2”，复制的次数位于 D 行 - 此代码将起作用。您需要先对其进行修改以满足您的需要！

Sub DuplicateRows()

Dim currentRow As Integer
Dim currentNewSheetRow As Integer: currentNewSheetRow = 1

For currentRow = 1 To 3 'The last row of your data

    Dim timesToDuplicate As Integer
    timesToDuplicate = CInt(Sheet1.Range("D" & currentRow).Value2)

    Dim i As Integer
    For i = 1 To timesToDuplicate

        Sheet2.Range("A" & currentNewSheetRow).Value2 = Sheet1.Range("A" & currentRow).Value2
        Sheet2.Range("B" & currentNewSheetRow).Value2 = Sheet1.Range("B" & currentRow).Value2
        Sheet2.Range("C" & currentNewSheetRow).Value2 = Sheet1.Range("C" & currentRow).Value2

        currentNewSheetRow = currentNewSheetRow + 1

    Next i

Next currentRow

End Sub

【讨论】：

【解决方案2】：

我做了一些修改和调整Francis Dean的答案：

对于那些使用 Office 2013（或 2010？）的用户，Excel 需要明确知道“Sheet1”是工作表的名称。
我还为更多的列和行调整了宏。例如currentRow 是Long，最后一行是Integer+1。
我确定重复的整数值在“J”中。

那么宏是：

Sub DuplicateRows()
    Dim currentRow As Long
    Dim currentNewSheetRow As Long: currentNewSheetRow = 1

    For currentRow = 1 To 32768 'The last row of your data
    Dim timesToDuplicate As Integer
    timesToDuplicate = CInt(Worksheets("Sheet1").Range("J" & currentRow).Value)
    Dim i As Integer
    For i = 1 To timesToDuplicate
        Worksheets("Sheet2").Range("A" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("A" & currentRow).Value
        Worksheets("Sheet2").Range("B" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("B" & currentRow).Value
        Worksheets("Sheet2").Range("C" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("C" & currentRow).Value
        Worksheets("Sheet2").Range("D" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("D" & currentRow).Value
        Worksheets("Sheet2").Range("E" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("E" & currentRow).Value
        Worksheets("Sheet2").Range("F" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("F" & currentRow).Value
        Worksheets("Sheet2").Range("G" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("G" & currentRow).Value
        Worksheets("Sheet2").Range("H" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("H" & currentRow).Value
        Worksheets("Sheet2").Range("I" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("I" & currentRow).Value
        currentNewSheetRow = currentNewSheetRow + 1
    Next i
Next currentRow
End Sub

【讨论】：

【解决方案3】：

我调整了 Francis 的答案，使其适用于当前活动的电子表格，并且仅适用于选定的行。我的特定用例需要将每个重复的数量更改为 1，因此“G”列设置为 1。

它仍然只适用于一组固定的列。

Sub MultiplySelectedRows()
'store reference to active sheet
Dim Source As Worksheet
Set Source = ActiveWorkbook.ActiveSheet
'create new sheet for output
Dim Multiplied As Worksheet
Set Multiplied = Sheets.Add(After:=Worksheets(Worksheets.Count))
'switch back to original active sheet
Source.Activate
Dim rng As Range
Dim lRowSelected As Long
Dim duplicateCount As Integer
Dim newSheetRow As Integer
newSheetRow = 1
For Each rng In Selection.Rows
    lRowSelected = rng.Row
    'Column holding number of times to duplicate each row is specified in quotes
    duplicateCount = CInt(Source.Range("G" & lRowSelected).Value)
    Dim i As Integer
    For i = 1 To duplicateCount
        'one copy statement for each column to be copied
        Multiplied.Range("A" & newSheetRow).Value = Source.Range("A" & lRowSelected).Value
        Multiplied.Range("B" & newSheetRow).Value = Source.Range("B" & lRowSelected).Value
        Multiplied.Range("C" & newSheetRow).Value = Source.Range("C" & lRowSelected).Value
        Multiplied.Range("D" & newSheetRow).Value = Source.Range("D" & lRowSelected).Value
        Multiplied.Range("E" & newSheetRow).Value = Source.Range("E" & lRowSelected).Value
        Multiplied.Range("F" & newSheetRow).Value = Source.Range("F" & lRowSelected).Value
        'multiplier is replaced by 1 (16x1 instead of 1x16 lines)
        Multiplied.Range("G" & newSheetRow).Value = 1
        Multiplied.Range("H" & newSheetRow).Value = Source.Range("H" & lRowSelected).Value
        Multiplied.Range("I" & newSheetRow).Value = Source.Range("I" & lRowSelected).Value
        Multiplied.Range("J" & newSheetRow).Value = Source.Range("J" & lRowSelected).Value
        Multiplied.Range("K" & newSheetRow).Value = Source.Range("K" & lRowSelected).Value
        Multiplied.Range("L" & newSheetRow).Value = Source.Range("L" & lRowSelected).Value
        newSheetRow = newSheetRow + 1
    Next i
Next rng

结束子

【讨论】：