ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何用VBA代码隐藏无有效数据行并每隔固定行数增加表头表尾?

如何用VBA代码隐藏无有效数据行并每隔固定行数增加表头表尾?

作者:绿色风 分类: 时间:2022-08-17 浏览:111
楼主
kevinchengcw
Q: 如何用VBA代码隐藏无有效数据行并每隔固定行数增加表头表尾?
A: 代码如下:
  1. Sub CreatePageBreak()
  2. Dim Rng As Range, R&, N&, Page%
  3. Application.ScreenUpdating = False '关闭屏幕刷新,提高处理速度
  4. With ActiveSheet
  5.     .ResetAllPageBreaks  '重设全部分页符
  6.     .PageSetup.PrintTitleRows = "" '取消标题行
  7.     Set Rng = .[a1:h6]  '设定标题范围
  8.     N = 1: R = 7: Page = 1 '初始化起始序号值,起始行号及页号
  9.     Do While .Cells(R, 2) <> ""  '循环数据区,当关键列不为空时(即未出数据区时)继续循环
  10.         If Val(.Cells(R, 5).Value) <> 0 Then '判断对应数据是否为有效数据,如果有效则执行下述代码
  11.             .Cells(R, 1) = N 'A列对应单元格等于当前序号值
  12.             If R > 25 And N Mod 25 = 1 Then '如果不是第一页,且序号为25的位数加1,则在当前行位置插入标题行+页脚行数相应的行
  13.                 .Rows(R & ":" & R + Rng.Rows.Count).Insert
  14.                 .Cells(R, 1).Resize(1, 8) = "页脚"
  15.                 .HPageBreaks.Add .Cells(R + 1, 1) '页脚前添加分页符
  16.                 Rng.Copy .Cells(R + 1, 1) '粘贴上标题行
  17.                 Page = Page + 1  '页码加1
  18.                 .Cells(R, 1).Offset(3, 7) = "第 " & Page & " 页" '写入对应的页号信息
  19.                 R = R + Rng.Rows.Count + 1 '行号值要加上插入的行数值,以跳过刚插入的分页信息区
  20.             End If
  21.             N = N + 1 '序号加1
  22.         Else '如果数据无效则隐藏该行
  23.             .Rows(R).Hidden = True
  24.         End If
  25.         R = R + 1
  26.     Loop
  27.     If N Mod 25 <> 1 Then '如果最后剩余的行数不够一行,及继续向下循环,并添加对应区域的边框线
  28.         Do While N Mod 25 <> 1
  29.             .Cells(R, 1).Resize(1, 8).Borders.LineStyle = 1
  30.             N = N + 1
  31.             R = R + 1
  32.         Loop
  33.     End If
  34.     With .Cells(R, 1).Resize(1, 8) '达到一页要求的行数时添加页脚行
  35.         .Value = "页脚"
  36.         .Borders.LineStyle = 1
  37.     End With
  38. End With
  39. Application.ScreenUpdating = True '打开屏幕刷新
  40. End Sub


详细效果参见原帖。
2楼
無心
来学习一下,

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap