运行宏很速度很慢 5块钱红包 求助【excel吧】_百度贴吧
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&签到排名：今日本吧第个签到，本吧因你更精彩，明天继续来努力！
本吧签到人数：0成为超级会员，使用一键签到本月漏签0次！成为超级会员，赠送8张补签卡连续签到：天&&累计签到：天超级会员单次开通12个月以上，赠送连续签到卡3张
关注：155,657贴子：
运行宏很速度很慢 5块钱红包 求助收藏
没重装电脑前用的excel2007重装电脑后用的excel2010 现在用这个2010的运行宏速度很慢 什么原因 怎么解决 在此谢过了帮忙解决给5块钱红包
FoxTable 2017上市, 轻松输入, 轻松统计, 轻松生成Excel报表, 快速搭建管理软件.
代码什么样的？
代码都不贴出来。。。
我自己写了一个宏，以前运行起来很快，几秒钟就完成了，最近运行越来越慢了，哪位高手看一下是什么原因啊。Dim r1stSubCell As Range
' 小计区域第一个单元格' -------------------------------------------------' 从这里开始执行Sub Main()
Application.ScreenUpdating = False
Worksheets(&sheet1&).Activate
删除分页符
Set r1stSubCell = Range(&A3&)
' 本例名单从 A3 单元格开始
For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown))
If rCurrentCell = &本页小计& Or rCurrentCell = &总
计& Then rCurrentCell.EntireRow.Delete
Set r1stSubCell = Range(&A3&)
' 本例名单从 A3 单元格开始
For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown))
If rCurrentCell = &本页小计& Or rCurrentCell = &总
计& Then rCurrentCell.EntireRow.Delete
新建分页小计
Range(&A3&).Activate
MsgBox &分页小计已完成!& & Chr(13) & &共用时间& & Round(Timer - T, 2) & &秒&
Application.ScreenUpdating = TrueEnd Sub' -------------------------------------------------Sub 删除原有的分页小计行()
Application.ScreenUpdating = False
Set r1stSubCell = Range(&A3&)
' 本例名单从 A3 单元格开始
For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown))
If rCurrentCell = &本页小计& Or rCurrentCell = &总
计& Then rCurrentCell.EntireRow.Delete
Set r1stSubCell = Range(&A3&)
' 本例名单从 A3 单元格开始
For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown))
If rCurrentCell = &本页小计& Or rCurrentCell = &总
计& Then rCurrentCell.EntireRow.Delete
Range(&A1&).Activate
MsgBox &已成功删除分页小计&
Application.ScreenUpdating = TrueEnd SubSub 新建分页小计()
Dim iSubCol As Integer, rSubArea As Range
Dim hb As HPageBreak
Worksheets(&sheet1&).Activate
Rows(Range(&a65536&).End(xlUp).Row).Copy Range(&a& & Range(&a65536&).End(xlUp).Row + 1)
Rows(Range(&a65536&).End(xlUp).Row).ClearContents
Range(&a& & Range(&a65536&).End(xlUp).Row + 1) = & &
ActiveWindow.View = xlPageBreakPreview
' 进入 分页浏览 模式, 以便 EXCEL 正确计页
Set r1stSubCell = Range(&A3&)
' 本例名单从 A3 单元格开始
iSubCol = 4
' 本例小计项共有 4 列
' 最后一行插入手工分页符
ActiveSheet.HPageBreaks.Add before:=r1stSubCell.End(xlDown).Offset(1, 0)
ActiveSheet.HPageBreaks.Add before:=Range(&a65536&).End(xlUp)
' 测试每一个分页符,
' 如果是自动分页符, 则在其上一行插入一小计行, 而本行纳入下一页
' 否则, 在本行插入一小计行
For Each hb In ActiveSheet.HPageBreaks
Set rCurrentCell = hb.Location
rCurrentCell.Select
' 看看先
If hb.Type = xlPageBreakAutomatic Then Set rCurrentCell = rCurrentCell.Offset(-1, 0)
rCurrentCell.EntireRow.Insert
Set rCurrentCell = rCurrentCell.Offset(-1, 0)
' 添加分页小计内容
With rCurrentCell
.Value = &本页小计&
.Font.Bold = True
'Set rSubArea = Application.Union(Range(&k& & rCurrentCell.Row), Range(&q& & rCurrentCell.Row))
' 需要填充分页小计公式的区域7列
'Set rSubArea = Range(&k& & rCurrentCell.Row, &q& & rCurrentCell.Row)
'需要填充分页小计公式的区域，k至q列的区域（共7列）
r = rCurrentCell.Row
Set rSubArea = Union(Range(&k& & r), Range(&o& & r), Range(&p& & r), Range(&q& & r))
'其中4列（\k\\o\p\q)
' 使用 SUBTOTAL 公式的好处是方便扩展, 且不会对已计算区域重复计算(如果可能发生这种情况的话)
rSubArea.Formula = &=SUBTOTAL(9,& & r1stSubCell.Offset(0, 10).Address(1, 0) & &:& & .Offset(-1, 10).Address(1, 0) & &)&
'其中9,表示&sum& ,10表示从A3向右移动10列
Set r1stSubCell = .Offset(1, 0)
Rows(Range(&a65536&).End(xlUp).Row).Clear
If Range(&A65536&).End(xlUp) = & & Then Rows(Range(&a65536&).End(xlUp).Row).Clear
Rows(Range(&a65536&).End(xlUp).Row).Copy Range(&a& & Range(&a65536&).End(xlUp).Row + 1)
Rows(Range(&a65536&).End(xlUp).Row).ClearContents
With Range(&A& & Range(&A65536&).End(xlUp).Row + 1)
.Value = &总
.Font.Bold = True
'Set rSubArea = Range(&b& & Range(&A65536&).End(xlUp).Row, &z& & Range(&A65536&).End(xlUp).Row) 'Z列
r = Range(&A65536&).End(xlUp).Row
Set rSubArea = Union(Range(&k& & r), Range(&o& & r), Range(&p& & r), Range(&q& & r))
''其中4列（\k\o\p\q)
rSubArea.Offset(0, 0) = &=SUBTOTAL(9,& & &K3:k& & Range(&A65536&).End(xlUp).Row - 1 & &)&
删除分页符
ActiveWindow.View = xlNormalViewEnd SubSub 删除分页符()On Error Resume Next
T = ActiveSheet.HPageBreaks.Count
For n = T To 1 Step -1
If ActiveSheet.HPageBreaks(n).Extent = xlPageBreakFull Then
ActiveSheet.HPageBreaks(n).Delete
T = ActiveSheet.HPageBreaks.Count
NextEnd Sub
登录百度帐号推荐应用}