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

Question

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

为了清楚起见，假设我有 2 行:

|  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

我希望它对你有帮助。我玩得很开心!