为何Excel VBA代码在部分设备上运行速度慢2000倍？

问题背景 #

开发了一个数据密集型Excel VBA宏，大量使用Collection对象。该宏在部分设备上运行极快，但在另一些设备上运行异常缓慢。已将问题隔离为以下示例代码（仅用于复现性能问题，非功能性程序）。

测试环境与结果 #

所有测试设备均使用Microsoft® Excel® for Microsoft 365 MSO (Version 2210 Build 16.0.15726.20188) 32-bit版本，测试结果如下：

• Intel(R) Core(TM) i9-10900K CPU @ 3.70GHz，内存16.0 GB：
  循环运行耗时0.09秒，内存清理耗时0.04秒。
• 11th Gen Intel(R) Core(TM) i7-1185G7 @ 3.00GHz，内存16.0 GB：
  循环运行耗时0.10秒，内存清理耗时0.05秒。
• Intel(R) Core(TM) i7-7700K CPU @ 4.20GHz，内存32.0 GB：
  循环运行耗时162.58秒，内存清理耗时5.48秒。
• Intel(R) Core(TM) i7-8665U CPU @ 1.90GHz，内存16.0 GB：
  循环运行耗时201.03秒，内存清理耗时6.37秒。

复现代码 #

VBA过程代码 #

Option Explicit
    
Sub largeCollection()

    Dim time1 As Single
    Dim time2 As Single
    time1 = Timer


    Dim myCollection As New Collection

    
    Dim I As Long
    Dim aClass1 As Class1
    
    For I = 2 To 50000
        Set aClass1 = New Class1

        aClass1.d1 = I
        aClass1.d2 = I
        aClass1.d3 = I
        aClass1.d4 = I
        aClass1.d5 = I
        aClass1.d6 = I
        aClass1.d7 = I
        aClass1.d8 = I
        aClass1.d9 = I
        aClass1.d10 = I

        aClass1.i1 = I
        aClass1.i2 = I
        aClass1.i3 = I
        aClass1.i4 = I
        aClass1.i5 = I
        aClass1.i6 = I
        aClass1.i7 = I
        aClass1.i8 = I
        aClass1.i9 = I
        aClass1.i10 = I
        
        myCollection.Add aClass1
    Next I
    
    time2 = Timer
    
    Set myCollection = Nothing
    
    'Notify user in seconds
    Debug.Print "Run loop took " & Format((time2 - time1), "0.00") & " seconds. Clearing memory took " & Format((Timer - time2), "0.00") & " seconds."
    
End Sub

自定义类Class1代码 #

Option Explicit

Public s1 As String
Public s2 As String
Public s3 As String
Public s4 As String
Public s5 As String
Public s6 As String
Public s7 As String
Public s8 As String
Public s9 As String
Public s10 As String
Public s11 As String
Public s12 As String
Public s13 As String
Public s14 As String
Public s15 As String
Public s16 As String
Public s17 As String
Public s18 As String
Public s19 As String
Public s20 As String

Public v1 As Variant
Public v2 As Variant
Public v3 As Variant
Public v4 As Variant
Public v5 As Variant
Public v6 As Variant
Public v7 As Variant
Public v8 As Variant
Public v9 As Variant
Public v10 As Variant

Public i1 As Long
Public i2 As Long
Public i3 As Long
Public i4 As Long
Public i5 As Long
Public i6 As Long
Public i7 As Long
Public i8 As Long
Public i9 As Long
Public i10 As Long

Public d1 As Double
Public d2 As Double
Public d3 As Double
Public d4 As Double
Public d5 As Double
Public d6 As Double
Public d7 As Double
Public d8 As Double
Public d9 As Double
Public d10 As Double

解决方案建议 #

1. 替换Collection为数组
   VBA原生Collection在处理大量自定义对象时，部分旧CPU可能存在COM交互效率问题。改用数组存储自定义对象可减少COM调用开销：

Sub largeArray()
    Dim time1 As Single, time2 As Single
    time1 = Timer
    
    Dim objArray() As Class1
    ReDim objArray(2 To 50000)
    
    Dim I As Long
    For I = 2 To 50000
        Set objArray(I) = New Class1
        objArray(I).d1 = I
        objArray(I).d2 = I
        objArray(I).d3 = I
        objArray(I).d4 = I
        objArray(I).d5 = I
        objArray(I).d6 = I
        objArray(I).d7 = I
        objArray(I).d8 = I
        objArray(I).d9 = I
        objArray(I).d10 = I

        objArray(I).i1 = I
        objArray(I).i2 = I
        objArray(I).i3 = I
        objArray(I).i4 = I
        objArray(I).i5 = I
        objArray(I).i6 = I
        objArray(I).i7 = I
        objArray(I).i8 = I
        objArray(I).i9 = I
        objArray(I).i10 = I
    Next I
    
    time2 = Timer
    Erase objArray
    
    Debug.Print "Run loop took " & Format((time2 - time1), "0.00") & " seconds. Clearing memory took " & Format((Timer - time2), "0.00") & " seconds."
End Sub

2. 优化类的内存布局
   将自定义类中同类型变量放在一起，减少内存碎片和CPU缓存失效：

Option Explicit
' 先放数值类型
Public i1 As Long, i2 As Long, i3 As Long, i4 As Long, i5 As Long
Public i6 As Long, i7 As Long, i8 As Long, i9 As Long, i10 As Long

Public d1 As Double, d2 As Double, d3 As Double, d4 As Double, d5 As Double
Public d6 As Double, d7 As Double, d8 As Double, d9 As Double, d10 As Double

' 再放字符串
Public s1 As String, s2 As String, s3 As String, s4 As String, s5 As String
Public s6 As String, s7 As String, s8 As String, s9 As String, s10 As String
Public s11 As String, s12 As String, s13 As String, s14 As String, s15 As String
Public s16 As String, s17 As String, s18 As String, s19 As String, s20 As String

' 最后放Variant
Public v1 As Variant, v2 As Variant, v3 As Variant, v4 As Variant, v5 As Variant
Public v6 As Variant, v7 As Variant, v8 As Variant, v9 As Variant, v10 As Variant

3. 启用VBA编译优化
   在VBA编辑器中，依次点击工具→选项→通用，勾选编译时删除调试信息，提升运行效率。

4. 调整Office硬件加速设置
   打开Excel→文件→选项→高级，找到显示部分，取消勾选禁用硬件图形加速，部分旧CPU的集成显卡可能与Office硬件加速存在兼容性问题，导致VBA运行缓慢。

5. 改用64位Office版本
   32位Office在处理大量对象时存在内存地址空间限制，改用64位Office（需确保所有插件兼容）可提升内存管理效率，缓解性能瓶颈。

内容的提问来源于stack exchange，提问作者Dennis van den Berg