Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2264|回复: 5

[已解决]重复填充

[复制链接]
发表于 2016-4-5 10:09 | 显示全部楼层 |阅读模式
本帖最后由 jk0932 于 2016-4-5 15:10 编辑

如附件所示,现在需要在Sheet1输入原始数据,如Sheet“结果”将每个数据重复6次,
Sheet1输入的原始数据行数是可变的!

最佳答案
2016-4-5 10:37
Sub test()
    Dim i%
    With Sheets(2)
        .Range("a:b").ClearContents
        Sheets(1).Range("a1:b1").Copy .Range("a1")

        For i = 1 To 6
            Sheets(1).Range("a2:b" & Sheets(1).Range("a65536").End(xlUp).Row) _
                    .Copy .Range("a65536").End(xlUp).Offset(1, 0)
        Next i

        .Range("a1").CurrentRegion.Sort .[a1], xlAscending, , , , , , xlYes
    End With
End Sub

重复6次b.rar (16.11 KB, 下载次数: 7)

重复6次.rar

7.46 KB, 下载次数: 4

发表于 2016-4-5 10:37 | 显示全部楼层    本楼为最佳答案   
Sub test()
    Dim i%
    With Sheets(2)
        .Range("a:b").ClearContents
        Sheets(1).Range("a1:b1").Copy .Range("a1")

        For i = 1 To 6
            Sheets(1).Range("a2:b" & Sheets(1).Range("a65536").End(xlUp).Row) _
                    .Copy .Range("a65536").End(xlUp).Offset(1, 0)
        Next i

        .Range("a1").CurrentRegion.Sort .[a1], xlAscending, , , , , , xlYes
    End With
End Sub

重复6次b.rar (16.11 KB, 下载次数: 7)
回复

使用道具 举报

 楼主| 发表于 2016-4-5 11:36 | 显示全部楼层
有高效点的代码吗?有很多行之后就会卡死
回复

使用道具 举报

发表于 2016-4-5 11:58 | 显示全部楼层
请选出最佳答案。
回复

使用道具 举报

发表于 2016-4-5 15:39 | 显示全部楼层
Sub test()
    Dim A, i%
    With Sheets(2)
        .Range("a:b").ClearContents
        .Range("a1:b1").Value = Sheets(1).Range("a1:b1").Value
        A = Sheets(1).Range("a2:b" & Sheets(1).Range("a65536").End(xlUp).Row)

        For i = 1 To 6
            .Range("a65536").End(xlUp).Offset(1, 0).Resize(UBound(A), UBound(A, 2)) = A
        Next i
        .Range("a1").CurrentRegion.Sort .[a1], xlAscending, , , , , , xlYes
    End With
End Sub


不带格式,可以吗
回复

使用道具 举报

发表于 2016-4-5 15:58 | 显示全部楼层
Sub test()
    Dim r As Long
    Application.ScreenUpdating = False
    r = Sheets(1).Range("a1").Range("a65536").End(xlUp).Row
    With Sheets(2)
        .Range("a:b").ClearContents
        Sheets(1).Range("a1").CurrentRegion.Copy .Range("a1")
        .Range("A2:B" & r).AutoFill Destination:=.Range("A2:B" & (r - 1) * 6 + 1)
        .Range("a1").CurrentRegion.Sort .[a1], xlAscending, , , , , , xlYes
    End With
End Sub
重复6次d.rar (18.21 KB, 下载次数: 1)
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 14:00 , Processed in 0.845004 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表