如何补全行数？

pnwzj

为保障打印美观度，需要让表头和表尾（合计行）的中间区域为最少为15行，超过15行忽略，不够15行则从合计行上一行进行插入。（不参照或不考虑A列序号是否正确）

求vba实现方式。多谢。万分感谢。

chxw68

楼主只上传了一张这么简单的表格，实在看不明白是怎么使用的。猜测有两种情况：一是这张表格是模板，另外还有一张表格是数据库，打印的时候从数据库里提取数据到模板批量打印。二是直接在这张表里输入数据，一张一张进行打印。针对这两种情况处理的方法是不一样的，不知道楼主采取的是哪种？

pnwzj

chxw68 发表于 2019-3-17 09:45
楼主只上传了一张这么简单的表格，实在看不明白是怎么使用的。猜测有两种情况：一是这张表格是模板，另外还 ...

多谢关注。
简单来讲，就是实现：表头到表尾中间的区域最少15行。不足15行时，从合计行上方进行插入，满足至少15行的要求。

wzsy2_mrf

1. Sub bchs()
   
2.     Dim arr, i&, j&, r&
   
3.     ReDim arr(1 To 17, 1 To 7)
   
4.     r = Columns("A:A").Find(what:="填表人：", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
   
5.     arr = Range("A5:G21")
   
6.     arr(r - 4, 1) = ""
   
7.     arr(r - 4, 4) = ""
   
8.     arr(r - 5, 1) = ""
   
9.     arr(r - 5, 3) = ""
   
10.     arr(UBound(arr), 1) = "填表人："
    
11.     arr(UBound(arr), 4) = "负责人："
    
12.     arr(UBound(arr) - 1, 1) = "合计"
    
13.     Range("A5:G21").Clear
    
14.     Range("A5:G21") = arr
    
15.     Range("A" & r - 1 & ":B" & r - 1).UnMerge
    
16.     Range("A20:B20").Merge
    
17.     Range("A5:G20").Borders.LineStyle = 1
    
18. End Sub
    
19. 
    

复制代码

chxw68

pnwzj 发表于 2019-3-17 18:51
多谢关注。
简单来讲，就是实现：表头到表尾中间的区域最少15行。不足15行时，从合计行上方进行插入，满 ...

这个用手工插入就行了，不需要用VBA吧？

岁月峥嵘2013

我是初学者，来论坛练手，哈哈
Sub 补全行数()
    Dim i, xianYouHangShu As Integer
    Application.ScreenUpdating = False
    xianYouHangShu = Application.Match("合计", Range("A:A"), 0)
    If xianYouHangShu < 20 Then
        For i = 1 To 20 - xianYouHangShu
            Rows("5:5").Select
            Selection.Insert Shift:=xlDown
        Next
        For i = 1 To 15
            Cells(i + 4, 1) = i
        Next
    End If
    Range("A19").Select
    Application.ScreenUpdating = True
End Sub

雾里花

学习了，之前有碰过这样的问题

maditate

你就不能实际设计张15行的打印表里面填数据？如果数据超过15行就另填一张打印表不可以吗？

pnwzj

岁月峥嵘2013 发表于 2019-3-17 19:42
我是初学者，来论坛练手，哈哈
Sub 补全行数()
    Dim i, xianYouHangShu As Integer

感谢帮助。但是有点小问题，代码运行的结果并不是从合计行之上插入，而是从第一行开始插入。