Excel vba宏根据单元格整数值多次复制行 [英] Excel vba macro copy rows multiple times based on a cell integer value

问题描述

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

I am looking for a VBA Excel macro that copies complete rows to another work sheet. It would need to create additional duplicate copies of that row based on a cell integer value.

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

This is helpful when using a mail merge where you want to create multiple copies of a document or label. I've found several answers which are close, but nothing that copies full rows

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

Input
col1 | col2 | col3 | col4
dogs | like | cats | 1
rats | like | nuts | 3
cats | chew | rats | 2

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

Output col1 | col2 | col3 | col4
dogs | like | cats
rats | like | nuts
rats | like | nuts
rats | like | nuts
cats | chew | rats
cats | chew | rats

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

Values in Output col4 could exist, doesn't matter for my case

推荐答案

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

I've made some changes and adjusted Francis Dean's answer:

• 对于使用 Office 2013(或 2010?)的用户，Excel 需要明确知道Sheet1"是工作表的名称.
• 我还为更多的列和行调整了宏.例如，currentRow 是 Long，最后一行是 Integer+1.
• 我确定重复的整数值在J"中.

• For those on Office 2013 (or 2010?), Excel needs to know explicitly that "Sheet1" is the name of a Sheet.
• Also I adapted the macro for more columns and rows. For example currentRow is Long and the last row being Integer+1.
• My integer value to determine duplicating is in "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

这篇关于Excel vba宏根据单元格整数值多次复制行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！