Question

我有一张大表，其中包含这样的数据（ProductName，ProductId，RepeatNumber）

我想在一个新的Sheet（Sheet2）上创建一个新的数据集。该宏将从Sheet1复制数据，并且将插入的行数可以在C列中看到（插入的宏已经可以做到），但是我想将这些数据放在新的Sheet（Sheet2）上并在由ProductID创建的新工作表（在Sheet2上）的B列中提供一个ItemId。 ItemId的前5个字符与ProductId相同，后两个是01、02、03，依此类推，直到重复编号为止。

由于Sheet1上的这些原始数据在不断变化，因此在Sheet1上添加了新行，我想要一个输入框，用于提供需要从中运行宏的行号。第一个数据（由宏创建）将放置在Sheet2列A的最后一个非空行中。第一次输入值将为2（宏需要从第二行开始运行。）

如何根据需要在新工作表上多次创建特殊的ItemId？

谢谢。

我有这样的宏：

Sub Multicopy()

Dim xRow As Long

Dim RepeatNum As Variant

xRow = 1

Application.ScreenUpdating = False

Do While (Cells(xRow, "A") <> "")

    RepeatNum = Cells(xRow, "C")

    If ((RepeatNum > 1) And IsNumeric(RepeatNum)) Then

       Range(Cells(xRow, "A"), Cells(xRow, "C")).Copy

       Range(Cells(xRow + 1, "A"), Cells(xRow + RepeatNum - 1, "C")).Select

       Selection.Insert Shift:=xlDown

       xRow = xRow + RepeatNum - 1

    End If

    xRow = xRow + 1

Loop

Application.ScreenUpdating = False

End Sub

Answer 1

这似乎比您采用的方法更有效/更直接。

代码将从StartRow（由用户在InputBox中确定）运行到LRow（由Sheet1 Col A确定）。

i循环将遍历上面Sheet1 Col A上指定的范围。
j循环确定“粘贴”您的值（从Sheet1 Col C指定）的次数

Sub Test()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim StartRow As Long, LRow As Long, i As Long, j As Long

LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
StartRow = Application.InputBox("Enter Row Number to Start On", , , , , , , 1)

For i = StartRow To LRow
    For j = 1 To ws.Range("A" & i).Offset(, 2).Value
        LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1).Row
        ws2.Range("A" & LRow2).Value = ws.Range("A" & i).Value
        ws2.Range("B" & LRow2).Value = ws.Range("B" & i).Value & j
    Next j
Next i

End Sub

验证InputBox条目（应该从第一个可用行-最后一个可用行）时值得。您还需要说明用户点击Cancel

上的InputBox按钮时的某些操作

编辑：

通过将ws.Range("B" & i).Value & j更改为ws.Range("B" & i).Value & WorksheetFunction.Text( j , "00")

，您可以将序列号从 1 更改为 01

Answer 2

您曾说过要在“新表”上使用扩展的值，我从字面上理解。此例程创建一个新的工作表并将其命名为Items。 FillDown用于静态扩展，而带有xlFillSeries的AutoFill用于渐进式扩展。

Option Explicit

Sub Multicopy()
    Dim i As Long, arr As Variant

    With Worksheets("sheet1")
        arr = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "C").End(xlUp)).Value2
    End With

    With Worksheets.Add(after:=Worksheets("sheet1"))
        .Name = "Items"
        .Cells(1, "A").Resize(1, 2) = Array("ProductName", "ItemID")

        For i = LBound(arr, 1) To UBound(arr, 1)
            With .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Resize(1, 2) = Array(arr(i, 1), arr(i, 2) & "01")
                .Resize(arr(i, 3), 1).FillDown
                .Offset(0, 1).AutoFill Type:=xlFillSeries, _
                                       Destination:=.Offset(0, 1).Resize(arr(i, 3), 1)
            End With
        Next i
    End With

End Sub

多次复制行（在一个单元格中给出），并根据单元格添加唯一的ID号

2 个答案:

编辑：