1.3 代码优化之道
开发程序首要需求是准确性,其次是执行速度决定程序的优劣。如何在准确性的基础上提升代码的速度是程序员的必修课。本节对代码优化之道通过案例进行详解,每个案例使用了不同的方案对程序提速,读者在实际工作中可以多个方案套用。
疑难9 如何优化过程“隐藏偶数行”
过程“隐藏偶数行”的代码如下,如何对它进行优化,使其速度更快?
Sub 隐藏偶数行() Dim i As Integer For i = ActiveSheet.UsedRange.Rows.Count To 2 Step -1 If i Mod 2 = 0 Then Rows(i).Hidden = True '如果行号除以2余数为0则隐藏 Next i End Sub
解决方案
本例速度优化可以从屏幕更新入手,关闭屏幕更新可以大大提升执行速度;而代码的写法优化则可以去除IF,提升书写速度。
操作方法
步骤1 对程序进行优化,代码如下:
Sub 隐藏偶数行2() '优化后,效率提高10倍左右 Dim i As Integer, tim tim=timer '记录当前时间,秒为单位 Application.ScreenUpdating=False '关闭屏幕更新 For i=ActiveSheet.UsedRange.Rows.Count To 2 Step -1 Rows(i).Hidden=(i Mod 2=0) '行的隐藏属性由行号除以2的余数决定 Next i Application.ScreenUpdating=True '恢复屏幕更新 MsgBox Format(timer-tim, "0.00秒") '报告时间 End Sub
步骤2 执行优化后的过程“隐藏偶数行2”,在笔者的电脑中对50行数据执行隔行隐藏时间为0.06 s,而优化前的过程“隐藏偶数行”则需要0.5 s。
原理分析
※ 关闭ScreenUpdating提升程序效率 ※
程序在操作对象时,屏幕会闪动,用户可以看到一步步执行的过程,然而事实上没这个必要,将屏幕的更新关闭后程序可以大大加快进程。但在执行完毕后必须恢复,否则有后遗症。
知识扩展
屏幕实时更新会造成程序执行缓慢,但有时也会故意让它实时更新,甚至将更新的速度减慢,以实现动画功能,让用户可以更清晰地查看动画效果,在后面的章节会涉及。
本例的程序除了关闭屏幕更新实现提速外,还可以借用减少单元格读写次数及借用数组来进一步提速(在后面还将会有专门的案例讲述减少单元格读写次数及借用数组两个优化方案)。代码如下:
Sub 隐藏偶数行3() Dim i As Integer, tim, arr() As String, j As Integer j = ActiveSheet.UsedRange.Rows.Count '记录行数 ReDim arr(1 To j) '声明数组上标和下标 tim = timer '记录当前时间,秒为单位 Application.ScreenUpdating = False '关闭屏幕更新 For i = 1 To j arr(i) = IIf(i Mod 2, 1, "") '将1和空字符写入数组 Next i With Cells(1, 256).Resize(j, 1) '创建辅助区 .Value = WorksheetFunction.Transpose(arr) '将数组写入辅助区 '定位空单元格并整行隐藏 .SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True .Clear '删除辅助区 End With Application.ScreenUpdating = True '恢复屏幕更新 MsgBox Format(timer - tim, "0.00秒") '报告时间 End Sub
疑难10 如何优化过程“设置字体属性”
以下程序是对A1向下延伸到最后一个非空单元格的区域设置字体属性,如何对它进行优化使程序的效率更高?
Sub 设置字体属性() ActiveWorkbook.Sheets(1).Range([a2], [a2].End(xlDown)).Font.Bold = True '加粗 ActiveWorkbook.Sheets(1).Range([a2], [a2].End(xlDown)).Font.Italic = True '倾斜 ActiveWorkbook.Sheets(1).Range([a2], [a2].End(xlDown)).Font.Color Index = 3 '红色 ActiveWorkbook.Sheets(1).Range([a2], [a2].End(xlDown)).Font.Name = " 方正姚体" '设定字体 ActiveWorkbook.Sheets(1).Range([a2], [a2].End(xlDown)).Font.Size = 21 '指定字体大小 ActiveWorkbook.Sheets(1).Range([a2], [a2].End(xlDown)).Font. Strikethrough = False '删除线 ActiveWorkbook.Sheets(1).Range([a2], [a2].End(xlDown)).Font. Superscript = False '取消上标 ActiveWorkbook.Sheets(1).Range([a2], [a2].End(xlDown)).Font. Subscript = False '取消下标 ActiveWorkbook.Sheets(1).Range([a2], [a2].End(xlDown)).Font.Underline = xlUnderlineStyleDouble '指定双下画线 End Sub
解决方案
对于多次调用相同对象者,可以利用 With 语句来简化,不仅在书写上简化,在执行效率上也可以有所提升,即通过With将多次调用对象改为调用一次。
操作方法
步骤1 通过With改写程序,让对象仅仅调用一次,代码如下:
Sub 设置字体属性2() '利用With优化程序 With ActiveWorkbook.Sheets(1).Range([a2], [a2].End(xlDown)).Font '设置字体 .Bold = True '加粗 .Italic = True '倾斜 .ColorIndex = 3 '红色 .Name = "方正姚体"'设定字体 .Size = 21 '指定字体大小 .Strikethrough = False '不要删除线 .Superscript = False '不要上标 .Subscript = False '不要下标 .Underline = xlUnderlineStyleDouble '指定双下画线 End With End Sub
步骤2 分别执行两段代码,可以发现其效果完全一致,但不管是书写还是执行效率上,第二段代码都会占有优势。
原理分析
※ 利用With简化对象引用 ※
在VBA中,表示多个层级的对象时,利用句点来做分隔符。例如“sheet1.[a1]”表示工作表sheet1的A1单元格。句点越多,程序的速度越慢。本例中利用WITH减少对象的读取次数,同时也对代码的输入工作进行了简化。
知识扩展
With语句必须以End With结束,编写代码时需写完整,否则将出现语法错误。
疑难11 如何优化过程“隔三行求和”
某车间三人一个小组,生产表按图1-26所示方式存放产量,利用 VBA 求和的代码如下。如何进行优化使其提速?
█ 图1-26 产量表
Sub 隔三行求和() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row '循环每一行 '如果行号除以4等于1则产生求和公式,向前三行求和 If i Mod 4 = 1 Then Cells(i, 3).Formula = "=sum(C" & i - 3 & ":C" & i - 1 & ")" Next End Sub
解决方案
上面程序中 For...Next 循环对每个行号进行余数判断,虽然可以完成需求,但并非必要。可以通过For...Next循环的Step参数来优化代码,简化循环的次数。
操作方法
步骤1 对For...Next循环进行改进,优化后的代码如下:
Sub 隔三行求和2() Dim i As Integer For i = 5 To Cells(Rows.Count, 1).End(xlUp).Row Step 4 '每隔三行循环一次 '对i行3列的单元格设置求和公式,向前三行求和 Cells(i, 3).Formula = "=sum(C" & i - 3 & ":C" & i - 1 & ")" Next End Sub
步骤2 执行过程“隔三行求和2”,可以发现两个过程的执行结果完全一致,但工作表中数据越多,两者的速度差异就越大。
原理分析
For...Next循环默认的步长值为1,可以忽略不写。而步长为4时则循环的次数缩短至四分之一,其执行效率也相应提升。
知识扩展
※ 减少单元格的写入次数提升程序效率 ※
本例还有另一个解决方案,即减少单元格的写入次数来进一步提速,代码如下:
Sub 隔三行求和3() Dim i As Integer, rng As Range For i = 5 To Cells(Rows.Count, 1).End(xlUp).Row Step 4 '每隔三行循环一次 '将符合条件的单元格合并,赋予变量对象rng If rng Is Nothing Then Set rng = Cells(i, 3) Else Set rng = Application. Union(rng, Cells(i, 3)) Next rng.FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)" '对变量rng代表的区域一次性指定公式 End Sub
此方案中将符合条件的多个单元格进行合并,然后赋予变量Rng,最后对变量一次赋值,即仅仅写入单元格一次。相对前一个方案在效率上有进一步提升。
对多单元格设置公式,通常采用R1C1方式设置公式,即相对引用,在书写时更方便。
疑难12 如何优化过程“B列所有图片右移”
如图1-27所示的B列图片需要全部向右移动两个单位,VBA代码如下。如何对它进行优化使程序效率更高呢?
█ 图1-27 待移位的图片
Sub B列图右移2个单位() Dim Sh As Shape, i As Integer i = 2 '指定变量基数2,表示图片从第二行开始 For Each Sh In Sheets(1).Shapes '循环所有图片 '如果图片左上角地址等于i行2列的单元格地址 If Sh.TopLeftCell.Address = Cells(i, 2).Address Then i = i + 1 '累加变量 Sh.Select '选择处于B列的图片 Selection.Left = Selection.Left + 2 '将选择的对象右移2个单位 End If Next Sh End Sub
解决方案
删除代码中的Select语句,直接移动对象。
操作方法
步骤1 修改选择对象的语句,直接移动对象,代码如下:
Sub B列图片右移2个单位2() '不选择对象而移动 Dim Sh As Shape, i As Integer i = 2 For Each Sh In Sheets(1).Shapes If Sh.TopLeftCell.Address = Cells(i, 2).Address Then i = i + 1 Sh.Left = Selection.Left + 2 '将符合条件的对象Sh右移两个单位 End If Next Sh End Sub
步骤2 分别执行两段代码,它们可以实现相同功能,但在执行效率上大大不同,图片越多,差异越大。
原理分析
对对象的操作,大部分情况下不需要选择对象,而是直接通过对象自身的方法对它进行操作,从而避免多余的“Select”动作来防止屏幕闪动,可以大大提速。
知识扩展
※ 有针对性地使用Select方法 ※
在工作表中操作对象,例如对单元格设置字体、字号,是一定要选择对象再执行操作,VBA代码为Select。然而在VBA中操作绝大部分对象都不需要选择对象的,这可以大大提高代码执行效率。有少数状况需要选择对象,例如选择性粘贴、修改批注框的大小等。
利用数组,本例还可以更快,即将每个符合条件的图片名称存入数组中,最后通过“Shapes.Range(数组)”来操纵所有符合条件的图片,不管图片多少仅需要移动一次。
Sub B列图片右移2个单位3() '一次性移动所有对象,利用数组获取对象名,一次性操作对象 Dim Sh As Shape, i As Integer, j As Integer, a() i = 2 '指定变量基数2,表示图片从第二行开始 For Each Sh In Sheets(1).Shapes '循环所有图片 '如果图片左上角地址等于i+j行2列的单元格地址 If Sh.TopLeftCell.Address = Cells(i + j, 2).Address Then j = j + 1 '累加变量,该变量表示符合条件的图片个数 ReDim Preserve a(1 To j) '重新声明变量的上标 a(j) = Sh.Name '将图片的名称写入数组 End If Next Sh ActiveSheet.Shapes.Range(a).IncrementLeft 2 '将所有图片右移2个单位 End Sub
疑难13 如何优化过程“建工作表目录”
对工作簿中所有工作表提取名称存放在A列,过程代码如下。如何进行优化,使其效率更高呢?
Sub建工作表目录() Dim i As Integer For i = 1 To Sheets.Count '循环每一个工作表 Cells(i, 1) = Sheets(i).Name '将工作表名写入i行1列 Next End Sub
解决方案
将多次写入单元格的方式改用数组来处理,从而只需对单元格写入一次,以提升效率。
操作方法
步骤1 改用数组获取工作表名,再一次性写入单元格,完整代码如下:
Sub建工作表目录2() Dim i As Integer, arr() '声明一个数组 ReDim arr(1 To Sheets.Count, 0) '重置数组的维数和上标 For i = 1 To Sheets.Count '循环每一个工作表 arr(i, 0) = Sheets(i).Name '将工作表名写入数组 Next [a1].Resize(Sheets.Count, 1) = arr '将数组的值一次性写入单元格 End Sub
步骤2 分别执行两段代码,其结果一致,但效率上有较大的差异,执行后的结果如图1-28所示。
█ 图1-28 工作表目录
原理分析
用代码操作单元格远远比操作数组更慢。基于此原理,尽量将单元格多次写入的操作改用写入数组,最后将数组的值一次性赋予单元格。在速度上通常数十倍或者上千倍地提升。
知识扩展
※ VBA中数组的作用 ※
数组最主要有两个作用:数据交换,相当于辅助区,临时存放数据,在需要时回写;提速,即将对象操作变通为数组的操作,从而大大提升效率。
有很多时候,内置的数组函数也可以对程序大大提速。在后面的案例将有所涉及。
疑难14 如何优化过程“成绩评语”
在成绩表中,B列存放学生成绩,要求对不及格成绩添加蓝色背景,在C列标识“不及格”,而对95分以上者标识“优秀”,最后在 E1单元格显示不及格人数。实现此需求可以用以下代码,如何对它进行优化?
Sub 成绩评语() ‘成绩评语及不及格数量计算 Dim rng As Range, i As Integer For Each rng In Range([b2], Cells(Rows.Count, 2).End(xlUp)) '遍历所有成绩 If rng < 60 Then '如果小于60 i = i + 1 '累计不及格人员数量 [c1] = "评语" '写标题 rng.Offset(0, 1) = "不及格" '对不及格成绩写标语 rng.Interior.ColorIndex = 5 '对不及格成绩着色 [d1] = "不及格:" & i & "人" '记录不及格人员数量 ElseIf rng > 95 Then '如果大于95分 rng.Offset(0, 1) = "优秀" '大于95分者评为优秀 End If Next rng End Sub
解决方案
清除循环语句中不必要的代码,将其移到循环之外,减少对象写入次数。
操作方法
步骤1 将不需要循环的语句置于循环体之外,可以减少代码重复执行,完整代码如下:
Sub 成绩评语及不及格数量计算2() '将不需要循环的代码移到循环语句外 Dim rng As Range, i As Integer [c1] = "评语" '写标题 For Each rng In Range([b2], Cells(Rows.Count, 2).End(xlUp)) '遍历所有成绩 If rng < 60 Then '如果小于60 i = i + 1 '累计不及格人员数量 rng.Offset(0, 1) = "不及格" '对不及格成绩写标语 rng.Interior.ColorIndex = 5 '对不及格成绩着色 ElseIf rng > 95 Then '如果大于95分 rng.Offset(0, 1) = "优秀" '大于95分者评为优秀 End If Next rng [d1] = "不及格:" & i & "人" '记录不及格人员数量 End Sub
步骤2 分别执行两段代码,它们可以实现相同的功能,执行结果如图1-29所示。
█ 图1-29 执行结果
原理分析
※ 区分适合置于循环体中的语句 ※
For...Next 循环语句表示多次执行一句或多句代码,但是通常该语句会产生不同结果。如果代码多次执行总产生相同结果,那么它不适合放在循环体中间浪费执行时间。在本例中,C1赋值只需要一次,不需要循环执行;而D1的不及格数量虽然会变化,但以最后一次结果为准,也仅需要执行一次。将它们放到循环体之外可以节约执行时间。
知识扩展
除了本例中的不需要多次赋值的语句外,声明变量、With语句、同一对象的Select方法等都不需要放在循环体中。
疑难15 如何优化过程“删除空单元格所在行”
批量删除工作表中的空行是比较常见的操作,其代码如下,可以简化吗?
Sub 删除空单元格所在行() Dim i As Integer Application.ScreenUpdating = False '关掉屏幕刷新从而提速 For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1 '循环判断B列所有数据 If Len(Cells(i, 2)) = 0 Then Cells(i, 2).EntireRow.Delete '如果字符长度为0则整行删除 Next Application.ScreenUpdating = True '恢复屏幕更新 End Sub
解决方案
利用定位法一步完成删除空单元格所在行。
操作方法
步骤1 不采用循环方案,而用定位法,代码如下:
Sub 删除空单元格所在行2() On Error Resume Next '防止不存在空单元格时出错 '定位B列的空单元格,然后整行删除 Range([b2], Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub
步骤2 分别执行两段代码,均可实现 B 列空单元格整行删除的需求,但优化后的过程效率较高。
原理分析
※ 不用循环而选择多个符合条件的单元格 ※
优化前的过程虽然采用了关闭屏幕更新的方式提速,然而循环检查每个单元格并逐个删除行仍然有较大的提速空间。SpecialCells 方法可以一次性选择所有空单元格,通过“EntireRow.Delete”删除行仅仅对单元格对象操作一次,相对优化前可以大大提速。
知识扩展
SpecialCells方法就是【F5】键定位功能所对应的VBA代码,它可以实现瞬间选择某个特定条件的所有单元格,从而避免循环。SpecialCells有着相当广阔的应用前景,以下过程是不利用循环而一次性删除B列所有值为60的单元格,让后面的单元格向上移:
Sub 删除B列等于60的单元格() '删除单元格,后面的上移 On Error Resume Next '将60一次性替换成错误值 Columns("B:B").Replace What:="60", Replacement:="#DIV/0!", LookAt: =xlWhole '将错误单元格删除,后面的上移 Columns("B:B").SpecialCells(xlCellTypeConstants, 16).Delete End Sub
SpecialCell 也有自身的限制,不适合太大的区域。例如删除 A1:IV60000中的空单元格。对于这种相当大的区域中删除空白行可以采用数组及配合排序方式完成,读者可以思考此方案的代码。
疑难16 如何优化过程“批量修改批注背景色”
工作表中A列为姓名,B列为成绩,在A列中部分单元格有批注。将所有批注的背景色修改为红色,其代码如下。那么如何才能优化代码而提升速度呢?
Sub 批量修改批注框背景色() Dim rng As Range On Error Resume Next '防错 For Each rng In Range([a1], Cells(Rows.Count, 1).End(xlUp)) '遍历A列所有非空单元格 Debug.Print rng.Comment.Text '导出批注文字 If Err = 0 Then '如果没有错误(表示有批注) rng.Comment.Visible = True '让批注可见 rng.Comment.Shape.Fill.ForeColor.SchemeColor = 10 '指定批注背景色 rng.Comment.Visible = False '恢复隐藏属性 End If Err.Clear '清除错误 Next End Sub
解决方案
将循环对象单元格修改为批注对象,其循环次数可以大大降低,从而提速。
操作方法
步骤1 修改代码循环的对象,完整代码如下:
Sub 批量修改批注框背景色2() '通过改变循环对象提速,即循环的次数减少 Dim Com As Comment For Each Com In ActiveSheet.Comments '遍历所有批注 If Not Intersect(Com.Parent, [a:a]) Is Nothing Then Com.Visible = True '让批注可见 Com.Shape.Fill.ForeColor.SchemeColor = 10 '指定批注背景色 Com.Visible = False '恢复隐藏属性 End If Next End Sub
步骤2 分别执行两段代码,优化后的代码明显速度更快,因为循环的次数已大大减少。
原理分析
本单元格与批注是一对一的关系,循环的主体使用单元格或者批注都可以实现对批注的操作。然而区域中单元格的数量通常都多于批注的数量,所以对批注进行循环远远比单元格循环速度更快。但也存在特殊情况,即工作表中图形对象相当多,但仅仅需要对一个小区域中的对象进行某个操作,即单元格数量少于图形对象时,就应该以单元格作为循环体,这需要用户判断后再决定代码的编写方式。
知识扩展
※ 区分父对象与子对象 ※
Comment 对象依附于单元格,其父对象 Parent 即为单元格对象。所以通过单元格可以获取批注,通过批注也可以获取单元格对象。
对批注的文字背景色或者形状、边框等进行操作时都必须让批注可见,而且要选择批注的外框,否则所有操作都无法进行。当操作完毕后再隐藏批注即可。
疑难17 如何优化过程“隔一行插入一行”
对图1-30所示的数据每隔一行插入一行,其代码如下。如何进行优化?
█ 图1-30 成绩表
Sub 隔一行插入行() Application.ScreenUpdating = False '关闭屏幕刷新 Dim i As Integer For i = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1 '遍历每个已用行 Rows(i).Insert '插入新行 Next Application.ScreenUpdating = True '恢复屏幕更新 End Sub
解决方案
图1-30所示的C列有计算公式,那么将自动计算修改为手动计算再插入行可以大大提速。
操作方法
步骤1 在执行插入行的代码前设置手动计算,完成插入行后恢复自动计算,完整代码如下:
Sub 隔一行插入行2() Application.ScreenUpdating = False '关闭屏幕刷新 Application.Calculation = xlManual '手动计算 Dim i As Integer For i = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1 Rows(i).Insert Next Application.Calculation = xlAutomatic '自动计算 Application.ScreenUpdating = True '恢复屏幕更新 End Sub
步骤2 分别执行两段代码,其结果一致,第二行开始每隔一行插入空行,如图1-31所示。
█ 图1-31 每隔一行插入一行
原理分析
※ 计算模式对程序效率的影响 ※
公式的特性是当前表格中任意单元格的值产生变化,或者插入、删除单元格时公式会自动重算。这意味着自动计算状态下,多次修改单元格会导致同一个公式多次重算,影响程序执行速度。所以,通常以手动计算状态下执行单元格操作,最后恢复自动计算的思路来对程序进行提速。
知识扩展
Calculation代表工作簿的计算模式,它有3个常量,含义见表1-1。
█ 表1-1
疑难18 如何优化过程“获取外网IP地址”
以下代码可以获取本机的外网地址,如何对其简化、提速?
Sub 查询外网IP() Dim xmlhttp As Object, strURL As String, i As Integer, j As Integer, IPStr As String '指定网址,该网具有获取IP的功能,本程序通过读取网页的数据来获取IP地址 strURL = "http://www.ip138.com/ip2city.asp" Set xmlhttp = CreateObject("Microsoft.XMLHTTP") '利用XMLHTTP对象获取网页数据 xmlhttp.Open "GET", strURL, False '打开网页 xmlhttp.send '获取信息 IPStr = xmlhttp.responsetext '取得包括IP地址的网页代码 '[a1] = IPStr If xmlhttp.Status = 200 Then i = InStr(IPStr, "[") '对 j = InStr(IPStr, "]") [a1] = Mid$(IPStr, i + 1, j - i - 1) Else [a1] = xmlhttp.Status & IPStr End If Set xmlhttp = Nothing End Sub
解决方案
以上过程中有过多的仅用一次的变量,可以进行简化。同时对字符中提取字符的算法过于繁杂,可以改用数组函数Split来取字符串。
操作方法
步骤1 通过删除变量,以及借用Split代替Mid$取字符串,完整代码如下:
Sub 查询外网IP2() '减少变量,改用 Split来取字符,从而简化代码,也可以提速 With CreateObject("Microsoft.XMLHTTP") .Open "GET", "http://www.ip138.com/ip2city.asp", False .send If .Status = 200 Then '利用Split提取[之后的字符,再用Split取]之前的字符 [a1] = Split(Split(.responsetext, "["](1), ")")(0) Else [a1] = .Status & .StatusText End If End With End Sub
步骤2 分别执行两段代码,可以获取本机外网IP地址。但第二个过程在书写和执行速度上均占优势。
原理分析
变量的作用是简化程序,有时也可用于提速。然而如果变量所代表的值或者对象仅仅需要使用一次时就不宜使用变量。另外,对基于某个字符位置而取字符的情况,使用 MID 函数计算起、止位置远远不如通过Split函数将字符串转成数组,并提取数组的第N个元素的思路快捷,而且在书写时不如Split函数方便。
知识扩展
※ 使用变量的条件 ※
文本需要多次调用时,通常借用变量来调用,可以实现程序的简化及提速。如果只需要使用一次就会本末倒置,不需要使用变量;对象需要多次调用时,可以使用对象变量,也可以通过With语句来简化对象的调用,两者都可以实现简化书写及提升速度的作用。
Split 函数用于返回一个下标从零开始的一维数组,它包含指定数目的子字符串。用它处理字符串相当方便。例如根据完整数据计算文件和盘符,代码如下:
a = "d:\生产表\123.xlsm" MsgBox "文件盘符: " & Split(a, "\")(0) & Chr(10) & "文件名: " & Split(a,"\")(UBound(Split(a, "\")))
除了本节讲述的10种方案优化代码外,还有其他很多方法,例如尽量使用带$的函数,即不用len而用len$函数;强制声明变量、多次调用固定值可改用常量;声明变量时使用最接近范围的类型等。读者可以在工作中探索更多的优化方案。