Excel VBA自动化 – 根据单元格值复制行“x”次数
我试图自动化Excel的方式，将节省我无数小时繁琐的数据input。 这是我的问题。
我们需要为我们的所有库存打印条形码，其中包括4000个具有特定数量的变体。
Shopify是我们的电子商务平台，他们不支持定制的出口; 但是，可以导出所有变体的CSV，其中包括库存盘点列。
我们使用Dymo为我们的条码打印硬件/软件。 Dymo每行只打印一个标签（忽略数量栏）。
有没有一种方法来自动化的Excel基于库存列中的值重复行“x”次？
这里是一个数据的例子：
https://www.evernote.com/shard/s187/sh/b0d5b92a-c5f6-469c-92fb-3d4e03d97544/d176d3448ba0cafbf3d61506402d9e8b/res/254447d2-486d-454f-8871-a0962f03253d/skitch.png
- 如果列N = 0，忽略并移动到下一行
- 如果列N> 1，复制当前行，“N”次（到另一张单）
我试图find一些做过类似的事情，以便我可以修改代码，但经过一个小时的search，我仍然是在我开始的地方。 预先感谢您的帮助！
大卫打败了我，但另一种方法从来没有伤害任何人。
考虑以下数据
Item Cost Code Quantity Fiddlesticks 0.8 22251554787 0 Woozles 1.96 54645641 3 Jarbles 200 158484 4 Yerzegerztits 56.7 494681818 1 有了这个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
在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
这个代码的注意事项是数量列中不能有空的字段。 我用D，所以可以用N代替你的情况。
应该足以让你开始：
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
可能有点迟，但这可以帮助其他人。 我已经在Excel 2010上testing了这个解决scheme。说：“Sheet1”是你的数据所在的工作表的名称，“Sheet2”是你希望重复数据的工作表。 假设您已经创build了这些图纸，请尝试下面的代码。
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
此解决scheme是David Zemens解决scheme的稍微修改版本。