一行复制成三行

dgzwz

sheet1要变成sheet2的格式，一行复制成三行并在前添加排序

cidanji

试看看，是不是这样

dgzwz

cidanji 发表于 2023-6-30 09:25
试看看，是不是这样

谢谢
0001
0001
0001
0002
0002
0002
0004
0004
0004
就是序号没有重排中间跳了001 002 003 004 005一直下去

ZHLK

Sub demo()

Sheet2.Rows("2:10000").ClearContents
a = 2
For i = 3 To Sheet1.Range("a65320").End(xlUp).Row
    For j = 1 To 3
        For k = 1 To 24
            Sheet2.Cells(a, j) = Sheet1.Cells(i, j)
        Next k
        a = a + 1
    Next j
Next i

End Sub

cidanji

以为你要使用原来的“序号”

ykcbf1100

参与一下。

dgzwz

cidanji 发表于 2023-6-30 09:48
以为你要使用原来的“序号”

谢谢！可以了

dgzwz

cidanji 发表于 2023-6-30 09:48
以为你要使用原来的“序号”

Sub ss()
    Dim arr(), brr(), i&, j&, m&, n&, q&
    arr = Range("A3:X" & Cells(Rows.Count, 1).End(3).Row)
    ReDim brr(1 To UBound(arr) * 3, 1 To UBound(arr, 2))
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            m = i * 3 - 2
            n = i * 3 - 1
            q = i * 3
            brr(m, j) = arr(i, j)
            brr(n, j) = arr(i, j)
            brr(q, j) = arr(i, j)
        Next
        brr(m, 1) = i
        brr(n, 1) = i
        brr(q, 1) = i
    Next
    Sheet2.Range("B2").Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub
如果只复制二行怎样修改代码