Excel精英培训网

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

[已解决]现在点击时是把换页符插到“发货清单”后面,可否把换页符插到“发货清单”行前面

[复制链接]
发表于 2015-1-29 17:20 | 显示全部楼层 |阅读模式
现在点击时运行是把换页符插到“发货清单”后面,改了好久也不能把换页符插到“发货清单”行前面?以方便换页打印,大家有没有办法实现

Sub 插入分页符()
Dim msg As String, i&, j&, d As Object, arr, dicitem
msg = InputBox("请输入关键字", "温馨提示", "发货清单")
If msg = "" Then Exit Sub
    Application.ScreenUpdating = False
    Set d = CreateObject("Scripting.Dictionary")
    Call 重置分页符
    arr = ActiveSheet.UsedRange
    For i = 1 To UBound(arr)
      For j = 1 To 6
        If InStr(arr(i, j), msg) Then d(i + 1) = ""
     Next j
    Next i
    arr(1, 1) = IIf(1026 > d.Count, d.Count, 1026) '一个工作表最多1026个分页符!!!
    dicitem = d.keys
    For i = 0 To arr(1, 1) - 1
         ActiveSheet.HPageBreaks.Add Before:=Range("A" & dicitem(i))
    Next
    Application.ScreenUpdating = True
    Set d = Nothing
MsgBox "已成功插入" & arr(1, 1) & "个分页符"
End Sub


Sub 重置分页符()
yy = ActiveSheet.PageSetup.Zoom
ActiveSheet.ResetAllPageBreaks
ActiveSheet.PageSetup.Zoom = yy
End Sub
最佳答案
2015-1-30 09:29
你的代码搞得太复杂了,简化了一下。
  1. Sub 插入分页符()
  2.     Dim msg As String, i&, n&
  3.     msg = InputBox("请输入关键字", "温馨提示", "发货清单")
  4.     If msg = "" Then Exit Sub
  5.     Set d = CreateObject("Scripting.Dictionary")
  6.     ActiveSheet.ResetAllPageBreaks
  7.     For i = 2 To [a65536].End(3).Row
  8.         If InStr(Cells(i, 1), msg) Then ActiveSheet.HPageBreaks.Add Before:=Cells(i, 1): n = n + 1
  9.     Next
  10.     MsgBox "已成功插入" & n & "个分页符"
  11. End Sub
复制代码

12.rar

17.69 KB, 下载次数: 5

发表于 2015-1-30 09:19 | 显示全部楼层
把  If InStr(arr(i, j), msg) Then d(i + 1) = ""  改成   If InStr(arr(i, j), msg) Then d(i) = ""  就行了
回复

使用道具 举报

发表于 2015-1-30 09:29 | 显示全部楼层    本楼为最佳答案   
你的代码搞得太复杂了,简化了一下。
  1. Sub 插入分页符()
  2.     Dim msg As String, i&, n&
  3.     msg = InputBox("请输入关键字", "温馨提示", "发货清单")
  4.     If msg = "" Then Exit Sub
  5.     Set d = CreateObject("Scripting.Dictionary")
  6.     ActiveSheet.ResetAllPageBreaks
  7.     For i = 2 To [a65536].End(3).Row
  8.         If InStr(Cells(i, 1), msg) Then ActiveSheet.HPageBreaks.Add Before:=Cells(i, 1): n = n + 1
  9.     Next
  10.     MsgBox "已成功插入" & n & "个分页符"
  11. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2015-1-30 10:41 | 显示全部楼层
谢谢呀,运行成功
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 04:35 , Processed in 0.601358 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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