Question

我需要帮助在Excel中创建一个宏，它会抓取某个单元格，并根据单元格的内容复制整行x次。

为了说清楚，我们说我有两行：

|  Order #  |  Item  |  Qty  |
|   30001   |   bag  |   3   |
|   30002   |   pen  |   1   |

我希望宏做的是抓取Qty列下的数字并复制整行并在其下插入一个内容完全相同的新行。它执行此操作的次数取决于Qty单元格中的数字。此外，它在Order #单元格中附加一个三位数字，以使其成为唯一的参考点。最终结果应该是什么：

|  Order #  |  Item  |  Qty  |
| 30001-001 |   bag  |   1   |
| 30001-002 |   bag  |   1   |
| 30001-003 |   bag  |   1   |
| 30002-001 |   pen  |   1   |

这里很难解释，但我希望你明白这一点。提前谢谢，大师！

Answer 1

以下代码支持数据中间的空白行。

如果Qty = 0，则不会在输出表中写入Item。

请插入至少1行数据，因为如果没有数据，它将无效：）

Option Explicit

Sub caller()
    ' Header at Row 1:
    '   "A1" = Order
    '   "B1" = Item
    '   "C1" = Qty
    '
    ' Input Data starts at Row 2, in "Sheet1"
    '
    ' Output Data starts at Row 2, in "Sheet2"
    '
    ' Sheets must be manually created prior to running this program
    Call makeTheThing(2, "Sheet1", "Sheet2")
End Sub


Sub makeTheThing(lStartRow As Long, sSheetSource As String, sSheetDestination As String)

    Dim c               As Range
    Dim rOrder          As Range
    Dim sOrder()        As String
    Dim sItem()         As String
    Dim vQty            As Variant
    Dim sResult()       As String
    Dim i               As Long

    ' Reads
    With ThisWorkbook.Sheets(sSheetSource)

        Set rOrder = .Range(.Cells(lStartRow, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)) ' It will work if there are blank lines in the middle!
        i = rOrder.Rows.Count
        ReDim sOrder(1 To i)
        ReDim sItem(1 To i)
        ReDim vQty(1 To i)

        i = 1
        For Each c In rOrder
            sOrder(i) = Trim(c.Text)
            sItem(i) = Trim(c.Offset(0, 1).Text)
            vQty(i) = c.Offset(0, 2).Value
            i = i + 1
        Next c

    End With

    ' Processes
    sResult = processData(sOrder, sItem, vQty)

    ' Writes
    ThisWorkbook.Sheets(sSheetDestination).Range("A" & lStartRow).Resize(UBound(sResult, 1), UBound(sResult, 2)).Value = sResult

End Sub


Function processData(sOrder() As String, sItem() As String, vQty As Variant) As String()

    Dim i               As Long
    Dim j               As Long
    Dim k               As Long
    Dim sResult()       As String

    j = WorksheetFunction.Sum(vQty) ' That's why vQty had to be Variant!
    ReDim sResult(0 To j, 1 To 3)
    k = 0

    For i = 1 To UBound(sOrder)
        For j = 1 To vQty(i)
            sResult(k, 1) = sOrder(i) & "-" & Format(j, "000")
            sResult(k, 2) = sItem(i)
            sResult(k, 3) = "1"
            k = k + 1
        Next j
    Next i

    processData = sResult

End Function

我希望它可以帮到你。我玩得很开心！

Answer 2

一种方法：根据需要向下走qty列，然后跳转到下一个原始行;

Sub unwind()
    Dim rowCount As Long, cell As Range, order As String, i As Long, r As Long

    Set cell = Range("C1")
    rowCount = Range("C" & rows.Count).End(xlUp).Row

    For i = 1 To rowCount
        order = cell.Offset(0, -2).Value

        For r = 0 To cell.Value - 1
            If (r > 0) Then cell.Offset(r).EntireRow.Insert
            cell.Offset(r, 0).Value = 1
            cell.Offset(r, -1).Value = cell.Offset(0, -1).Value
            cell.Offset(r, -2).Value = order & "-" & Format$(r + 1, "000")
        Next

        Set cell = cell.Offset(r, 0)
    Next
End Sub

在Excel中为每个行项创建唯一条目

2 个答案: