已解决老师帮忙修改代码

38180203

ykcbf1100 发表于 2024-6-12 15:16
参与一下。。。

老师:   最后一行会出来这个数字

ykcbf1100

38180203 发表于 2024-6-12 16:32
老师:   最后一行会出来这个数字

改一下就行。

38180203

小凡、、、 发表于 2024-6-12 13:36
另起一个表格存放会不会好一点

老师，我发了你的代码附件，，就是点几次就会会累加几次在后面   还有我想和原数据空10行再粘贴怎么修改，。谢谢

38180203

半百 发表于 2024-6-12 13:34

老师,您这个代码可以用,,就是重复点击会累加叠加 要怎增加什么代码,,谢谢

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     With Worksheets("sheet2")
   
7.         r = .Range("a4").End(xlDown).Row
   
8.         .Rows(r + 1 & ":" & .Rows.Count).Delete
   
9.         m = r + 3
   
10.         For i = 4 To r
    
11.             .Range("a2:y3").Copy .Cells(m, 1)
    
12.             .Cells(i, 1).Resize(1, 25).Copy .Cells(m + 2, 1)
    
13.             .Rows(m).RowHeight = 21.75
    
14.             .Rows(m + 1).RowHeight = 30.75
    
15.             .Rows(m + 2).RowHeight = 25
    
16.             .Rows(m + 3).RowHeight = 8
    
17.             m = m + 4
    
18.         Next
    
19.     End With
    
20. End Sub
    

复制代码

chxw68

参与一下。

38180203

chxw68 发表于 2024-6-13 08:38

完美解决.谢谢大佬

半百

38180203 发表于 2024-6-13 08:28
老师,您这个代码可以用,,就是重复点击会累加叠加 要怎增加什么代码,,谢谢

在for 语句前加一句