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

Question

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

excelvbaautomationduplicatesrows

4

我试图以一种自动化的方式来处理Excel，以节省无数小时繁琐的数据录入。这是我的问题。

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

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”次（到单独的工作表）

我试图找到做过类似事情的人，以便我可以修改代码，但是在搜寻了一个小时后，我仍然停留在原地。提前感谢您的帮助！

- Judson Hanna

您提供的链接拒绝访问。您能展示一下您目前所做的工作吗？在这里，您不会找到一个人为您完成整个工作，但您会找到下一步的一些帮助。 - stenci

3个回答

2

以下内容应该足以让你入门：

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

- David Zemens

谢谢David，但是当我运行宏时，似乎它为第14列中的每个值创建了一个新工作表（而不是新行）。我不能确定这是否是发生的事情，因为在工作簿中创建大约80个新工作表后，Excel会崩溃... - Judson Hanna

1

可能有点晚回答了，但这可以帮助其他人。我已经在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

这个解决方案是对David Zemens方案的轻微修改版。

- Kiran Kodukula

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Matt · Accepted Answer

David比我更快一步，但另一种方法也不会伤害任何人。

考虑以下数据

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

使用这个函数

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。