在 VBA 编程中，代码运行缓慢的常见原因之一是频繁操作工作表中的 Range 对象。相比之下，使用 数组（Array） 将数据读入内存进行处理，再一次性写回工作表，可以显著提升效率。本文从基础示例出发，逐步讲解如何利用数组优化 VBA 代码，并引入实用的技巧与函数。每一段代码后都附有详细说明。

一、基础示例：读取与写入单个值

场景与目的

从 A1 读取一个数值，乘以 10，写入 D1。
演示 VBA 应用的基本三步：读—算—写。
认识“工作表代码名（CodeName）”带来的稳健性（避免因重命名导致代码失效）。

' 假设在VBE中将某个工作表的代码名设为 shMarks（属性窗口F4可改）
Sub SimpleExample()
    Dim Marks As Long                        ' 1) 声明变量（数据容器）
    Marks = shMarks.Range("A1").Value        ' 2) 从工作表读取（读）
    Marks = Marks * 10                       ' 3) 处理中间逻辑（算）
    shMarks.Range("D1").Value = Marks        ' 4) 写回指定单元格（写）
End Sub

细致说明

Dim Marks As Long：用 Long 存整数更高效且足够大（-2,147,483,648 到 2,147,483,647）。若有小数应改为 Double。
shMarks.Range("A1").Value：建议优先使用代码名（如 shMarks），而不是 Worksheets("成绩")，防止用户改表名导致错误。
这是“单点 I/O”的典型示例：每次读/写都会跨越 VBA<->Excel 的“进程边界”，频繁调用会慢；后文将用数组减少边界往返。

二、问题出现：多学生场景（反例）

场景与目的

有 3 个学生，天真地“复制粘贴”处理每一行。
认识“硬编码”与“代码爆炸”的风险。

Sub MultiStudentsBad()
    Dim Marks1 As Long, Marks2 As Long, Marks3 As Long
    
    Marks1 = shMarks.Range("A1").Value: Marks1 = Marks1 * 10: shMarks.Range("D1").Value = Marks1
    Marks2 = shMarks.Range("A2").Value: Marks2 = Marks2 * 10: shMarks.Range("D2").Value = Marks2
    Marks3 = shMarks.Range("A3").Value: Marks3 = Marks3 * 10: shMarks.Range("D3").Value = Marks3
End Sub

细致说明

这种写法不可扩展：学生从 3 变 3000，代码将膨胀到无法维护。
逻辑重复、易出错（某一处复制遗漏或错位就会产生隐蔽 Bug）。
结论：应引入数组 + 循环，用“一个模板”处理 N 条记录。

三、数组与循环的引入（小规模、定长）

场景与目的

用数组承载多个学生的数值，结合 For 循环减少重复代码。
适用于固定规模的简单场景（演示为 1..3）。

Sub UseArray()
    Dim Marks(1 To 3) As Long    ' 固定长度的一维数组
    Dim i As Long
    
    For i = 1 To 3
        Marks(i) = shMarks.Range("A" & i).Value     ' 读
        Marks(i) = Marks(i) * 10                    ' 算
        shMarks.Range("D" & i).Value = Marks(i)     ' 写
    Next i
End Sub

细致说明

Marks(1 To 3)：声明了上界与下界。VBA 数组的下界可变（默认 0 或 1，受 Option Base 影响），建议显式声明范围，减少歧义。
Range("A" & i) 拼接地址要确保 i 与数据实际行数匹配；后文会用更稳健的“动态行数”。
性能仍未真正起飞：虽然减少了“代码行数”，但仍在逐单元格 I/O。真正的加速来自“批量读/写”。

四、动态数组与 ReDim（配合 LastRow）

场景与目的

学生人数每日不同，需运行时决定数组大小。
ReDim 用来“晚点再告知数组尺寸”，与 Dim 互补。

Sub DynamicArray()
    Dim LastRow As Long, i As Long
    Dim Marks() As Long                             ' 先声明为动态数组
    
    ' 找到A列的最后一行（从底部向上找首个非空）
    LastRow = shMarks.Cells(shMarks.Rows.Count, 1).End(xlUp).Row
    
    ReDim Marks(1 To LastRow)                       ' 运行时确定数组大小
    
    For i = 1 To LastRow
        Marks(i) = shMarks.Range("A" & i).Value
        Marks(i) = Marks(i) * 10
        shMarks.Range("D" & i).Value = Marks(i)
    Next i
End Sub

细致说明

shMarks.Rows.Count：在不同 Excel 版本中总行数不同（一般 1,048,576），该写法兼容性佳。
End(xlUp)：等价于在工作表按 End + ↑，从底部回到最后一个非空单元格。
ReDim：与 Dim 的差别在于何时确定尺寸；ReDim 只能用于动态数组。
仍是逐格读写，真正的优化在下一节。

五、一次性读写：用数组批处理（性能飞跃）

场景与目的

批量把 A 列数据一次性读入二维数组（来自 Range 的 .Value 总是二维），内存中计算后再一次性写回 D 列。
适合大数据量（成千上万行）的主力方案。

Sub ArrayBatchProcess()
    Dim Marks As Variant
    Dim i As Long, LastRow As Long
    
    LastRow = shMarks.Cells(shMarks.Rows.Count, 1).End(xlUp).Row
    Marks = shMarks.Range("A1:A" & LastRow).Value   ' 注意：来自Range的Value是二维数组(1..n, 1..1)
    
    For i = 1 To UBound(Marks, 1)                   ' 第一维是“行数”
        Marks(i, 1) = Marks(i, 1) * 10
    Next i
    
    shMarks.Range("D1:D" & LastRow).Value = Marks   ' 一次性写回（成倍提速的关键）
End Sub

细致说明

关键性能点：跨进程调用（VBA<->Excel）从“每行 2 次”→“进来一次、出去一次”。
UBound(Marks, 1)：1 表示第一维（行）；2 表示第二维（列）。
来自工作表的 .Value 是二维数组（即使是单列）：(行, 列)。一维数组会引发下标错误。
此模式是 VBA 提速的“黄金模板”。

六、用 CurrentRegion 获取动态表（代替 LastRow）

场景与目的

数据为连续区域（无隔行空白），用 CurrentRegion 自动识别整个表。
结合 Resize，无需传递“最后行/列”等参数。

Sub ReadWriteWithCurrentRegion()
    Dim rg As Range
    Dim arr As Variant
    
    Set rg = shMarks.Range("A1").CurrentRegion  ' 包含从A1开始的相邻数据块（自动扩展）
    arr = rg.Value                               ' 二维数组
    
    ' ……在内存中处理 arr……
    
    ' 写回：假设写入从D1起，与arr尺寸一致
    shMarks.Range("D1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

细致说明

CurrentRegion 等价于用户在表中按 Ctrl+*（或 Ctrl+Shift+8）。
若首行含表头，且你只想处理数据体，需额外“偏移 + 裁剪”（后文提供封装函数）。
Resize(r, c)：用数组的行列上界直接塑造目标区域大小，避免手工计算。

七、封装常用操作：数组写回 Range 的通用过程

场景与目的

频繁出现的“把二维数组写到某个起点”的动作，封装成一个过程，复用更方便。
隐藏 Resize 等样板代码，让主流程更清晰。

' 将二维数组写回以TargetCell为左上角的区域
Public Sub ArrayToRange(ByVal TargetArray As Variant, ByVal TargetCell As Range)
    TargetCell.Resize(UBound(TargetArray, 1), UBound(TargetArray, 2)).Value = TargetArray
End Sub

' 调用示例
Sub Demo_ArrayToRange()
    Dim rg As Range, arr As Variant
    Set rg = shMarks.Range("A1").CurrentRegion
    arr = rg.Value
    ' ……处理中略……
    Call ArrayToRange(arr, shMarks.Range("D1"))
End Sub

细致说明

统一入口：只需保证传入的是二维数组与左上角单元格。
更进一步：可扩展可选参数（如仅写前 N 行/前 M 列、是否自动清空目标区域等）。

八、避开表头：获取“当前区域的数据体”（封装版）

场景与目的

当前区域往往首行是表头，业务处理通常只针对数据体。
通过偏移 + 重新设定大小，自动返回“去表头”的二维数组。

' 获取去表头后的二维数组
Public Function GetCurrentRegionData(ByVal TopLeft As Range, Optional ByVal HeaderRows As Long = 1) As Variant
    Dim rg As Range, dataRg As Range
    Set rg = TopLeft.CurrentRegion                                ' 整块
    Set dataRg = rg.Offset(HeaderRows, 0).Resize(rg.Rows.Count - HeaderRows)  ' 下移去头，行数-头部
    GetCurrentRegionData = dataRg.Value
End Function

' 调用示例
Sub Demo_GetCurrentRegionData()
    Dim sales As Variant
    sales = GetCurrentRegionData(shMarks.Range("A1"), 1)           ' 1行表头
    ' ……对sales进行处理……
    ArrayToRange sales, shMarks.Range("F2")                        ' 从F2写出，自动按尺寸铺开
End Sub

细致说明

Offset(headerRows, 0)：从“整体区域”下移若干行，跳过表头。
Resize(rg.Rows.Count - headerRows)：把“数据体”裁出来。
返回值直接是二维数组，后续处理无需再次读表。

九、数组中的“过滤”：按条件挑记录并复制到新数组

场景与目的

在数组里做类似 SQL 的 WHERE 过滤：如“筛出 SalesPerson=Bill 的所有行”。
先把“源数据”读成 sales 数组，再把满足条件的行逐行复制到 outputArray。
不知道命中多少行时，可先按源数据最大尺寸开辟，再用“输出行计数”决定最终写出的有效范围。

Sub FilterInArray_WriteOut()
    Dim sales As Variant, outputArray As Variant
    Dim i As Long, j As Long, outputRow As Long
    Dim person As String
    
    ' 读入数据体（跳过1行表头）
    sales = GetCurrentRegionData(shMarks.Range("A1"), 1)
    
    person = shMarks.Range("K1").Value            ' 条件：K1中写入要筛选的姓名
    
    ' 根据源数组尺寸预开目标数组（行数足够，列数相同）
    ReDim outputArray(1 To UBound(sales, 1), 1 To UBound(sales, 2))
    
    ' 遍历源数组的每一行
    For i = 1 To UBound(sales, 1)
        ' 假设第2列是 SalesPerson
        If sales(i, 2) = person Then
            outputRow = outputRow + 1
            ' 逐列复制整行
            For j = LBound(sales, 2) To UBound(sales, 2)
                outputArray(outputRow, j) = sales(i, j)
            Next j
        End If
    Next i
    
    ' 只写出“有效命中行”（可能少于预开大小）
    If outputRow > 0 Then
        shMarks.Range("F2").Resize(outputRow, UBound(sales, 2)).Value = outputArray
    Else
        shMarks.Range("F2").CurrentRegion.ClearContents  ' 无数据时可选择清空原结果区
    End If
End Sub

细致说明

outputRow 是关键：用来记录“已经命中并写入了多少行”。
“预开大数组 + 只写有效区间”是常用技巧（无需在筛选过程中不断 ReDim Preserve，后者非常慢）。
常见错：下标越界（Subscript out of range）。如把二维数组当一维用，或索引越界。定位方法：

检查 UBound/LBound 维度是否正确；
检查“列号假设”（如上例认为第 2 列是 SalesPerson）是否与数据一致。

若想提升易用性，可把“复制整行”的逻辑封装为 ArrayCopyRow，把“按源尺寸设置目标数组”的逻辑封装为 ArraySetSize（示例如下）。

十、进一步封装：行复制与尺寸设定的复用过程

场景与目的

把重复出现的“设定目标数组尺寸”和“复制单行”的逻辑进一步抽离，主流程更简洁、更不易出错。

' 根据源数组，设置目标数组的行列大小（不赋值）
Public Sub ArraySetSize(ByRef dest As Variant, ByVal src As Variant)
    ReDim dest(1 To UBound(src, 1), 1 To UBound(src, 2))
End Sub

' 将src的某一行（srcRow）整行复制到dest的某一行（destRow）
Public Sub ArrayCopyRow(ByRef dest As Variant, ByVal destRow As Long, _
                        ByVal src As Variant, ByVal srcRow As Long)
    Dim j As Long
    ' 基本健壮性校验（可按需扩展更多场景）
    If UBound(dest, 2) <> UBound(src, 2) Then Err.Raise 5, , "列数不一致，无法复制整行。"
    For j = 1 To UBound(src, 2)
        dest(destRow, j) = src(srcRow, j)
    Next j
End Sub

' 使用封装的调用示例（对应上一节的筛选场景）
Sub FilterInArray_WithHelpers()
    Dim sales As Variant, outputArray As Variant
    Dim i As Long, outputRow As Long, person As String
    
    sales = GetCurrentRegionData(shMarks.Range("A1"), 1)
    person = shMarks.Range("K1").Value
    
    ArraySetSize outputArray, sales
    
    For i = 1 To UBound(sales, 1)
        If sales(i, 2) = person Then
            outputRow = outputRow + 1
            ArrayCopyRow outputArray, outputRow, sales, i
        End If
    Next i
    
    If outputRow > 0 Then
        shMarks.Range("F2").Resize(outputRow, UBound(sales, 2)).Value = outputArray
    Else
        shMarks.Range("F2").CurrentRegion.ClearContents
    End If
End Sub

细致说明

通过封装：

主流程只关注“业务意图”（条件判断与结果写出）；
细节（尺寸一致性、列循环）统一在过程里管理。

若在团队协作中推广这套封装，建议建立统一模块（如 modArrayUtils），集中维护。

十一、从 ListObject（表）直接读取数据体（可选）

场景与目的

如果数据来源是“Excel 表（ListObject）”，可以直接用 DataBodyRange 获取数据体，避免自行偏移与裁剪。
适用于你已将区域格式化为“表”的场景（在“表设计”中可查看表名）。

Sub ReadFromTableBody()
    Dim arr As Variant
    ' 假设 shMarks 工作表上有名为 "tbSales" 的表
    arr = shMarks.ListObjects("tbSales").DataBodyRange.Value
    ' ……处理arr……
    ArrayToRange arr, shMarks.Range("H2")
End Sub

细致说明

DataBodyRange 不含表头，直接返回数据体，非常省心。
若表为空，DataBodyRange 可能为 Nothing，需做判空处理（生产代码必做）。

十二、三类常用数据操作心智模型（在数组中实现）

场景与目的

绝大多数报表/业务处理可归纳为三类：
筛选（WHERE）：已在上文演示。
分组聚合（GROUP BY / SUM）：在数组中可用字典（Scripting.Dictionary）或排序+扫一遍完成。
表间合并（JOIN）：在数组中可用字典建立键→行映射，然后按键匹配拼接。
建议把“读入（Range→Array）”和“写出（Array→Range）”固定为模板，仅在中间“处理层”更换策略，以保持结构清晰与高可维护性。

常见坑与实用小贴士

一维/二维：来自 Range 的 .Value 始终是二维；不要当作一维使用。
边界函数：LBound/Ubound 必须指明维度：UBound(arr, 1) 行、UBound(arr, 2) 列。
ReDim Preserve：仅能改变最后一维大小，且耗时；能不用就不用。
清理输出区域：写出前可按需 TargetCell.CurrentRegion.ClearContents，防“遗留数据”。
类型匹配：文本与数值比较注意强制转换，避免隐式类型造成的逻辑误判。
代码名（CodeName）：优先使用（如 shMarks），防止改表名导致崩溃。

通过以上示例与详解，我们逐步展示了用数组优化 VBA 的路径：

用循环代替重复代码；2) 用“批量读写”替代“逐格 I/O”；
用封装提升复用性与可读性；4) 用心智模型把复杂业务拆解为“筛/聚/合”。

别怕，Excel VBA其实很简单（异步图书出品）

￥59.7

购买

使用数组优化 VBA 代码的实践与技巧

一、基础示例：读取与写入单个值

二、问题出现：多学生场景（反例）

三、数组与循环的引入（小规模、定长）

四、动态数组与 ReDim（配合 LastRow）

五、一次性读写：用数组批处理（性能飞跃）

六、用 CurrentRegion 获取动态表（代替 LastRow）

七、封装常用操作：数组写回 Range 的通用过程

八、避开表头：获取“当前区域的数据体”（封装版）

九、数组中的“过滤”：按条件挑记录并复制到新数组

十、进一步封装：行复制与尺寸设定的复用过程

十一、从 ListObject（表）直接读取数据体（可选）

十二、三类常用数据操作心智模型（在数组中实现）

常见坑与实用小贴士

相关推荐

我用 1 个 2 手计算器换了 3 台 MacBook(上)

零基础也能搞定!DeepSeek大模型本地安装全攻略

Win7中同时安装python2和python3的方法

按颜色计数、求和、算平均值或最大值?学这个函数就够啦!

SpringBoot中使用LocalDateTime踩坑记录

中药古今研究:人参

「mysql第二次安装不了」mysql安装失败怎么清理干净?

RSA 复杂题目 ?

深入理解Python中的try-except语句，避免代码崩溃的噩梦

python解释器管理工具pyenv使用说明