Question

将行复制x倍，然后粘贴到新的工作表x行数中。然后将“ S”的单元格值更改为“ x的1”，“ x的2”，“ x的3” ....“ x的x”。

“ Sheet1” Col“ S”保存x数值。在每一行中复制带有值的col“ B”至“ AJ”并粘贴到“ sheet3”中。

我使用了一些在堆栈溢出“ Copy Row X amount of times based on cell value”中找到的代码，但是需要它来更改添加的每一行中“ S”的值。

Sub Sample()
Dim wsI As Worksheet, wsO As Worksheet
Dim lRow_I As Long, lRow_O As Long, i As Long, j As Long

'~~> Set your input and output sheets
Set wsI = ThisWorkbook.Sheets("Sheet1")
Set wsO = ThisWorkbook.Sheets("Sheet3")

'~~> Output row
lRow_O = wsO.Range("B" & wsO.Rows.Count).End(xlUp).Row + 1

With wsI
    '~~> Get last row of input sheet
    lRow_I = .Range("B" & .Rows.Count).End(xlUp).Row

    '~~> Loop through the rows
    For i = 2 To lRow_I
        '~~> This will loop the number of time required
        '~~> i.e the number present in cell S
        For j = 1 To Val(Trim(.Range("S" & i).Value))
            '~~> This copies
            .Rows(i).Copy wsO.Rows(lRow_O)
            '~~> Get the next output row
            lRow_O = wsO.Range("B" & wsO.Rows.Count).End(xlUp).Row + 1
        Next j
    Next i
End With
End Sub

我希望工作表1上的每一行都在工作表3上，即该行值中的单元格“ S”（“ S” = 1到15之间的数字）的次数。然后，每个添加的新行的“ S”值为“ S of 1”，“ S of 2”为“ S of 2”，依此类推。

Answer 1

Sub Sample()

    Dim wsI As Worksheet, wsO As Worksheet
    Dim lRow_I As Long, lRow_O As Long, i As Long, j As Long
    Dim rw As Range, n As Long

    Set wsI = ThisWorkbook.Sheets("Sheet1")
    Set wsO = ThisWorkbook.Sheets("Sheet3")

    lRow_O = wsO.Range("B" & wsO.Rows.Count).End(xlUp).Row + 1
    lRow_I = wsI.Range("B" & wsI.Rows.Count).End(xlUp).Row

    For i = 2 To lRow_I

        Set rw = wsI.Rows(i)
        n = Val(Trim(rw.Range("S1").Value))

        rw.Copy wsO.Rows(lRow_O).Resize(n) 'makes n copies of the row

        'add the "x of n" values
        wsO.Cells(lRow_O, "S").Resize(n, 1).Value = Evaluate("=ROW(1:" & n & ") & "" of " & n & """")

        'or alternatively / less complex...
        for j = 1 to n
            wsO.Cells(lRow_O, "S").Offset(j-1, 0).Value = j & " of " & n
        next j

        lRow_O = lRow_O + n

    Next i

End Sub

如果x =“ cell value”，则将行复制和粘贴x次

1 个答案: