免责声明:我对vba和宏相对较新。
我已经编写了一个宏来更新某些单元格中的值和格式,然后通过http读取和解析json并且进程非常慢,所以我将代码分解成不同的部分以查看瓶颈可能在哪里。原来细胞更新是问题所在,我有以下代码:
Sub test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.EnableCancelKey = False
t = Timer
With Range("A1")
.Font.Italic = True
.Interior.ColorIndex = 37
.Value = 3412
End With
Debug.Print Timer - t
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.EnableCancelKey = True
End Sub
调试打印大约是0.3到0.5秒...之后我进一步将计时器包裹在每个italic
,colorIndex
和value
行周围,它们都变成了每个大约需要0.015秒...我尝试在线搜索如何提高代码效率,因此screenupdating
切换以及没有selection
,但0.5秒仍然看起来有点慢细胞给我。
此外,我已经在至少3台计算机上测试了这个脚本,它们都需要大约相同的时间,所以我不认为这是个人计算机问题。我使用excel 2007和2010进行测试。
答案 0 :(得分:2)
我假设您想要格式化多个单元格?如果是这样,为所有需要相同格式的单元格创建范围引用(它不需要是连续的)会更快,然后在一步中将所需格式应用于该范围对象
按照示例演示创建范围参考,并一次性应用格式
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub Demo()
Dim t As Long
Dim n As Long, i As Long
Dim m As Long
Dim ws As Worksheet
Dim cl As Range
Dim rSearch As Range
Dim rResult As Range
Set ws = ActiveSheet ' or another sheet...
Set rSearch = ws.Range("A1:A1000")
' note, this is an inefficient loop, can be made much faster
' details will depend on the use case
For Each cl In rSearch
' determine if cell is to be formatted
If cl.Row Mod 2 = 0 Then
' add cl to Result range
If rResult Is Nothing Then
Set rResult = cl
Else
Set rResult = Application.Union(rResult, cl)
End If
End If
Next
Debug.Print "Result Range includes ", rResult.Cells.Count, "Cells"
t = GetTickCount
' Apply format
With rResult
.Font.Italic = True
.Interior.ColorIndex = 37
.Value = 3412
End With
Debug.Print (GetTickCount - t) / 1000, "seconds"
End Sub