[已解决]SOS插入行的问题

h486

请高手和老师帮忙。1、如何从第4行开始每30行下或合计行下，插入一行在h，i格显示“第几页，共几页”（如“第1页，共4页”，未遇到合计行，运行到第二页显示“第2页，共4页”直至第4页），遇到合计行重新计算“第几页，共几页”（如“第1页，共2页”）。2、从数据行到合计行不足30行插入空白行格式不变，使其满足每页数据30行，合计行是31行。

最佳答案

月排行榜 / 总排行榜

白雪高山

2013-12-6 14:35

是不是这个意思
Sub a()
Application.ScreenUpdating = False
arra = Range("a4:a" & Range("a65536").End(xlUp).Row)
Dim arrb(1 To 10000, 1 To 1)
j = 1
arrb(1, 1) = 3 '标题行 4行为数据
For i = 1 To UBound(arra)
   If arra(i, 1) = "合 计" Then '找合计所在行
      j = j + 1
      arrb(j, 1) = i + 3
   End If
Next i
For ii = j To 2 Step -1 '循环合计次数的行
     r = arrb(ii, 1) - arrb(ii - 1, 1)  '合计行这间有相差多少行
     If r Mod 30 > 0 Then
         pa = Int(r / 30) + 1  '计算有几页
       Else
         pa = Int(r / 30)
      End If
      ins = pa * 30 - r '计算插入多少行
       For jj = pa To 1 Step -1 '循环页
           If jj = pa Then
              Rows(arrb(ii, 1) & ":" & arrb(ii, 1) + ins - 1).Insert
              Rows(arrb(ii, 1) + ins + 1).Insert
              Cells(arrb(ii, 1) + ins + 1, 8) = "第" & jj & "页, 共" & pa & "页"
            Else
              Rows(arrb(ii - 1, 1) + jj * 30 + 1).Insert
              
              Cells(arrb(ii - 1, 1) + jj * 30 + 1, 8) = "第" & jj & "页, 共" & pa & "页"
           End If
       Next jj
Next ii
Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

h486

老师or高手你们在哪？SOS

yyyydddd8888

h486 发表于 2013-12-6 11:09
老师or高手你们在哪？SOS

请测试：
插入行问题.rar (15.15 KB, 下载次数: 14)

2013-12-6 11:36 上传

点击文件名下载附件

h486

yyyydddd8888 兄弟你幸苦了，这也能做的到，太强了，我想了半年没想出来。
还有些问题就是
1、数据行需要是每30行插入第几页共几页，代码运行是29行插入第几页共几页。2、合计页不足30行插入空白行到30行，合计行在31行，这个没实现。3、建议增加删除a列为空的代码，再次运行不会出错。

白雪高山

用倒循环呀

yyyydddd8888

h486 发表于 2013-12-6 12:31
yyyydddd8888 兄弟你幸苦了，这也能做的到，太强了，我想了半年没想出来。
还有些问题就是
1、数据行需要 ...

不懂你的意思，
1、从第4行开始，到第33行刚好30行，所以在第33行插入了一个空行，如果在第34行插入空行，那么就是满31行插入空行了。
2、合计页不足30行插入空白行到30行，合计行在31行，这个没实现。
     这句彻底不理解什么意思。
3、建议增加删除a列为空的代码，再次运行不会出错。
     现在已经增加了删除行的代码。
插入行问题.rar (19.17 KB, 下载次数: 10)

2013-12-6 13:21 上传

点击文件名下载附件

h486

不好意思没表达清楚。我把想实现的效果表格发上来。

白雪高山

Sub a()
Application.ScreenUpdating = False
arra = Range("a4:a" & Range("a65536").End(xlUp).Row)
Dim arrb(1 To 10000, 1 To 1)
j = 1
arrb(1, 1) = 3 '标题行 4行为数据
For i = 1 To UBound(arra)
   If arra(i, 1) = "合 计" Then '找合计
      j = j + 1
      arrb(j, 1) = i + 3
   End If
Next i

For ii = j To 2 Step -1 '循环合计
     r = arrb(ii, 1) - arrb(ii - 1, 1) - 1 '合计行这间有相差多少行
     If r Mod 30 > 0 Then
         pa = Int(r / 30) + 1  '计算有几页
       Else
         pa = Int(r / 30)
      End If
      ins = pa * 30 - r '计算插入多少行
      
       For jj = pa To 1 Step -1 '循环页
           
           If jj = pa Then
              Rows(arrb(ii, 1) & ":" & arrb(ii, 1) + ins).Insert
              Cells(arrb(ii, 1) + ins, 8) = "第" & jj & "页, 共" & pa & "页"
            Else
              Rows(arrb(ii - 1, 1) + jj * 30 + 1).Insert
              Cells(arrb(ii - 1, 1) + jj * 30 + 1, 8) = "第" & jj & "页, 共" & pa & "页"
           End If
       Next jj
Next ii
Application.ScreenUpdating = True

End Sub

h486

谢谢雪高山，但你这段代码还是有问题。上图&表格。

白雪高山

是不是这个意思
Sub a()
Application.ScreenUpdating = False
arra = Range("a4:a" & Range("a65536").End(xlUp).Row)
Dim arrb(1 To 10000, 1 To 1)
j = 1
arrb(1, 1) = 3 '标题行 4行为数据
For i = 1 To UBound(arra)
   If arra(i, 1) = "合 计" Then '找合计所在行
      j = j + 1
      arrb(j, 1) = i + 3
   End If
Next i
For ii = j To 2 Step -1 '循环合计次数的行
     r = arrb(ii, 1) - arrb(ii - 1, 1)  '合计行这间有相差多少行
     If r Mod 30 > 0 Then
         pa = Int(r / 30) + 1  '计算有几页
       Else
         pa = Int(r / 30)
      End If
      ins = pa * 30 - r '计算插入多少行
       For jj = pa To 1 Step -1 '循环页
           If jj = pa Then
              Rows(arrb(ii, 1) & ":" & arrb(ii, 1) + ins - 1).Insert
              Rows(arrb(ii, 1) + ins + 1).Insert
              Cells(arrb(ii, 1) + ins + 1, 8) = "第" & jj & "页, 共" & pa & "页"
            Else
              Rows(arrb(ii - 1, 1) + jj * 30 + 1).Insert
              
              Cells(arrb(ii - 1, 1) + jj * 30 + 1, 8) = "第" & jj & "页, 共" & pa & "页"
           End If
       Next jj
Next ii
Application.ScreenUpdating = True
End Sub