叠加组合的问题

谢玉红

附件 叠加组合附件.rar (173.35 KB, 下载次数: 6)

2024-6-15 14:22 上传

点击文件名下载附件

谢谢老师！

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, r&, iPosRow&
   
    Application.ScreenUpdating = False
   
    ar = [A1].CurrentRegion.Value
    ReDim br(1 To UBound(ar) * 3, 1 To UBound(ar, 2))
   
    For i = 2 To UBound(ar)
        iPosRow = (i - 2) * 3
        r = iPosRow + 1
        For j = 1 To UBound(ar, 2)
            br(r, j) = ar(i - 1, j)
        Next j
        r = r + 1
        For j = 1 To UBound(ar, 2)
            br(r, j) = ar(i, j)
        Next j
    Next i
        
    Columns("P:S").Clear
    [P1].Resize(r, UBound(br, 2)) = br
   
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

。。。。。。。。。。。

笨鸟飞不高