Excel VBA 自动化 - 根据单元格值复制行“x”次

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/25395454/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 08:49:53  来源:igfitidea点击:

Excel VBA automation - copy row "x" number of times based on cell value

excelvbaautomationduplicatesrows

提问by Judson Hanna

I'm attempting to automate Excel in a way that will save me countless hours of tedious data entry. Here's my problem.

我正在尝试以一种可以为我节省无数小时的乏味数据输入的方式自动化 Excel。这是我的问题。

We need to print barcodes for all of our inventory, which includes 4,000 variants each with a specific quantity.

我们需要为我们所有的库存打印条形码,其中包括 4,000 种不同的变体,每个变体都有特定的数量。

Shopify is our e-commerce platform and they do not support customized exports; however, can export a CSV of all variants, which includes an inventory count column.

Shopify 是我们的电子商务平台,不支持定制出口;但是,可以导出所有变体的 CSV,其中包括库存计数列。

We use Dymo for our barcode printing hardware/software. Dymo will only print one label per row (it ignores the quantity column).

我们将 Dymo 用于条码打印硬件/软件。Dymo 每行只会打印一个标签(它忽略数量列)。

Is there a way to automate excel to duplicate the row "x" number of times based on the value in the inventory column?

有没有办法根据库存列中的值自动执行excel以复制行“x”次数?

Here's a sample of the data:

以下是数据示例:

https://www.evernote.com/shard/s187/sh/b0d5b92a-c5f6-469c-92fb-3d4e03d97544/d176d3448ba0cafbf3d61506402d9e8b/res/254447d2-486d-454f-8871-a0962f03253d/skitch.png

https://www.evernote.com/shard/s187/sh/b0d5b92a-c5f6-469c-92fb-3d4e03d97544/d176d3448ba0cafbf3d61506402d9e8b/res/2544847d2804d/2544847d2807d/2544847d2040d/2544847d2040d/254847fb-3d4e03d97544

  • If Column N = 0, ignore and move to next row
  • If Column N > 1, copy current row, "N" number of times (to a separate sheet)
  • 如果列 N = 0,则忽略并移至下一行
  • 如果第 N 列 > 1,则复制当前行“N”次(到单独的工作表)

I tried to find someone who had done something similar so that I could modify the code, but after an hour of searching I'm still right where I started. Thank you in advance for the help!

我试图找到做过类似事情的人,以便我可以修改代码,但经过一个小时的搜索,我仍然是我开始的地方。预先感谢您的帮助!

回答by Matt

David beat me to it but an alternate approach never hurt anyone.

大卫击败了我,但另一种方法从未伤害过任何人。

Consider the following data

考虑以下数据

Item           Cost Code         Quantity
Fiddlesticks   0.8  22251554787  0
Woozles        1.96 54645641     3
Jarbles        200  158484       4
Yerzegerztits  56.7 494681818    1

With this function

有了这个功能

Public Sub CopyData()
    ' This routing will copy rows based on the quantity to a new sheet.
    Dim rngSinglecell As Range
    Dim rngQuantityCells As Range
    Dim intCount As Integer

    ' Set this for the range where the Quantity column exists. This works only if there are no empty cells
    Set rngQuantityCells = Range("D1", Range("D1").End(xlDown))

    For Each rngSinglecell In rngQuantityCells
        ' Check if this cell actually contains a number
        If IsNumeric(rngSinglecell.Value) Then
            ' Check if the number is greater than 0
            If rngSinglecell.Value > 0 Then
                ' Copy this row as many times as .value
                For intCount = 1 To rngSinglecell.Value
                    ' Copy the row into the next emtpy row in sheet2
                    Range(rngSinglecell.Address).EntireRow.Copy Destination:= Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)                                
                    ' The above line finds the next empty row.

                Next
            End If
        End If
    Next
End Sub

Produces the following output on sheet2

在 sheet2 上产生以下输出

Item            Cost    Code        Quantity
Woozles         1.96    54645641    3
Woozles         1.96    54645641    3
Woozles         1.96    54645641    3
Jarbles         200     158484      4
Jarbles         200     158484      4
Jarbles         200     158484      4
Jarbles         200     158484      4
Yerzegerztits   56.7    494681818   1

The caveats with this code is that there can be no empty fields in the Quantity column. I used D so feel free to substitute N for your case.

此代码的警告是 Quantity 列中不能有空字段。我使用了 D,所以你可以随意用 N 代替你的情况。

回答by David Zemens

Should be enough to get you started:

应该足以让你开始:

Sub CopyRowsFromColumnN()

Dim rng As Range
Dim r As Range
Dim numberOfCopies As Integer
Dim n As Integer

'## Define a range to represent ALL the data
Set rng = Range("A1", Range("N1").End(xlDown))

'## Iterate each row in that data range
For Each r In rng.Rows
    '## Get the number of copies specified in column 14 ("N")
    numberOfCopies = r.Cells(1, 14).Value

    '## If that number > 1 then make copies on a new sheet
    If numberOfCopies > 1 Then
        '## Add a new sheet
        With Sheets.Add
            '## copy the row and paste repeatedly in this loop
            For n = 1 To numberOfCopies
                r.Copy .Range("A" & n)
            Next
        End With
    End If
Next

End Sub

回答by Kiran Kodukula

Might be a bit late to answer, however this could help others. I have tested this solution on Excel 2010. Say: "Sheet1" is the name of the sheet where your data is located and "Sheet2" is the sheet where you want your repeated data. Assuming you have these sheets created, try the below code.

回答可能有点晚了,但这可以帮助其他人。我已经在 Excel 2010 上测试了这个解决方案。说:“Sheet1”是您的数据所在的工作表的名称,“Sheet2”是您想要重复数据的工作表。假设您创建了这些工作表,请尝试以下代码。

Sub multiplyRowsByCellValue()
Dim rangeInventory As Range
Dim rangeSingleCell As Range
Dim numberOfRepeats As Integer
Dim n As Integer
Dim lastRow As Long

'Set rangeInventory to all of the Inventory Data
Set rangeInventory = Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("D2").End(xlDown))

'Iterate each row of the Inventory Data
For Each rangeSingleCell In rangeInventory.Rows
    'number of times to be repeated copied from Sheet1 column 4 ("C")
    numberOfRepeats = rangeSingleCell.Cells(1, 3).Value

    'check if numberOfRepeats is greater than 0
    If numberOfRepeats > 0 Then
         With Sheets("Sheet2")
            'copy each invetory item in Sheet1 and paste "numberOfRepeat" times in Sheet2

                For n = 1 To numberOfRepeats 
                lastRow = Sheets("Sheet1").Range("A1048576").End(xlUp).Row
                r.Copy
                Sheets("Sheet1").Range("A" & lastRow + 1).PasteSpecial xlPasteValues
            Next
        End With
    End If
Next

End Sub

This solution is slightly modified version of David Zemens solution.

此解决方案是 David Zemens 解决方案的略微修改版本。