使用vba进行慢速格式化?

时间:2014-07-28 02:45:52

标签: excel vba excel-vba

免责声明:我对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秒...之后我进一步将计时器包裹在每个italiccolorIndexvalue行周围,它们都变成了每个大约需要0.015秒...我尝试在线搜索如何提高代码效率,因此screenupdating切换以及没有selection,但0.5秒仍然看起来有点慢细胞给我。

请注意,我不是抱怨,我只是想知道我是否在这里做正确的事。有没有更有效的方法来实现我在这里发布的格式和值更改,或者只是excel花费这么多时间更新单元格的事实?我只是非常好奇,因为我实现的json读取和解析速度明显快于此。

此外,我已经在至少3台计算机上测试了这个脚本,它们都需要大约相同的时间,所以我不认为这是个人计算机问题。我使用excel 2007和2010进行测试。

1 个答案:

答案 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