摘要：在 VBA 编程中，代码运行缓慢的常见原因之一是频繁操作工作表中的Range对象。相比之下，使用数组（Array）将数据读入内存进行处理，再一次性写回工作表，可以显著提升效率。本文从基础示例出发，逐步讲解如何利用数组优化 VBA 代码，并引入实用的技巧与函数。
在 VBA 编程中，代码运行缓慢的常见原因之一是频繁操作工作表中的 Range 对象。相比之下，使用 数组（Array） 将数据读入内存进行处理，再一次性写回工作表，可以显著提升效率。本文从基础示例出发，逐步讲解如何利用数组优化 VBA 代码，并引入实用的技巧与函数。每一段代码后都附有详细说明。
场景与目的
从 A1 读取一个数值，乘以 10，写入 D1。演示 VBA 应用的基本三步：读—算—写。认识“工作表代码名（CodeName）”带来的稳健性（避免因重命名导致代码失效）。' 假设在VBE中将某个工作表的代码名设为 shMarks（属性窗口F4可改）Sub SimpleExampleDim 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 MultiStudentsBadDim Marks1 As Long, Marks2 As Long, Marks3 As LongMarks1 = shMarks.Range("A1").Value: Marks1 = Marks1 * 10: shMarks.Range("D1").Value = Marks1Marks2 = shMarks.Range("A2").Value: Marks2 = Marks2 * 10: shMarks.Range("D2").Value = Marks2Marks3 = shMarks.Range("A3").Value: Marks3 = Marks3 * 10: shMarks.Range("D3").Value = Marks3End Sub细致说明
这种写法不可扩展：学生从 3 变 3000，代码将膨胀到无法维护。逻辑重复、易出错（某一处复制遗漏或错位就会产生隐蔽 Bug）。结论：应引入数组 + 循环，用“一个模板”处理 N 条记录。场景与目的
用数组承载多个学生的数值，结合 For 循环减少重复代码。适用于固定规模的简单场景（演示为 1..3）。Sub UseArrayDim Marks(1 To 3) As Long ' 固定长度的一维数组Dim i As LongFor i = 1 To 3Marks(i) = shMarks.Range("A" & i).Value ' 读Marks(i) = Marks(i) * 10 ' 算shMarks.Range("D" & i).Value = Marks(i) ' 写Next iEnd Sub细致说明
Marks(1 To 3)：声明了上界与下界。VBA 数组的下界可变（默认 0 或 1，受 Option Base 影响），建议显式声明范围，减少歧义。Range("A" & i) 拼接地址要确保 i 与数据实际行数匹配；后文会用更稳健的“动态行数”。性能仍未真正起飞：虽然减少了“代码行数”，但仍在逐单元格 I/O。真正的加速来自“批量读/写”。场景与目的
学生人数每日不同，需运行时决定数组大小。ReDim 用来“晚点再告知数组尺寸”，与 Dim 互补。Sub DynamicArrayDim LastRow As Long, i As LongDim Marks As Long ' 先声明为动态数组' 找到A列的最后一行（从底部向上找首个非空）LastRow = shMarks.Cells(shMarks.Rows.Count, 1).End(xlUp).RowReDim Marks(1 To LastRow) ' 运行时确定数组大小For i = 1 To LastRowMarks(i) = shMarks.Range("A" & i).ValueMarks(i) = Marks(i) * 10shMarks.Range("D" & i).Value = Marks(i)Next iEnd Sub细致说明
shMarks.Rows.Count：在不同 Excel 版本中总行数不同（一般 1,048,576），该写法兼容性佳。End(xlUp)：等价于在工作表按 End + ↑，从底部回到最后一个非空单元格。ReDim：与 Dim 的差别在于何时确定尺寸；ReDim 只能用于动态数组。仍是逐格读写，真正的优化在下一节。场景与目的
批量把 A 列数据一次性读入二维数组（来自 Range 的 .Value 总是二维），内存中计算后再一次性写回 D 列。适合大数据量（成千上万行）的主力方案。Sub ArrayBatchProcessDim Marks As VariantDim i As Long, LastRow As LongLastRow = shMarks.Cells(shMarks.Rows.Count, 1).End(xlUp).RowMarks = 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) * 10Next ishMarks.Range("D1:D" & LastRow).Value = Marks ' 一次性写回（成倍提速的关键）End Sub细致说明
关键性能点：跨进程调用（VBA↔Excel）从“每行 2 次”→“进来一次、出去一次”。UBound(Marks, 1)：1 表示第一维（行）；2 表示第二维（列）。来自工作表的 .Value 是二维数组（即使是单列）：(行, 列)。一维数组会引发下标错误。此模式是 VBA 提速的“黄金模板”。场景与目的
数据为连续区域（无隔行空白），用 CurrentRegion 自动识别整个表。结合 Resize，无需传递“最后行/列”等参数。Sub ReadWriteWithCurrentRegionDim rg As RangeDim arr As VariantSet rg = shMarks.Range("A1").CurrentRegion ' 包含从A1开始的相邻数据块（自动扩展）arr = rg.Value ' 二维数组' ……在内存中处理 arr……' 写回：假设写入从D1起，与arr尺寸一致shMarks.Range("D1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arrEnd Sub细致说明
CurrentRegion 等价于用户在表中按 Ctrl+*（或 Ctrl+Shift+8）。若首行含表头，且你只想处理数据体，需额外“偏移 + 裁剪”（后文提供封装函数）。Resize(r, c)：用数组的行列上界直接塑造目标区域大小，避免手工计算。场景与目的
频繁出现的“把二维数组写到某个起点”的动作，封装成一个过程，复用更方便。隐藏 Resize 等样板代码，让主流程更清晰。' 将二维数组写回以TargetCell为左上角的区域Public Sub ArrayToRange(ByVal TargetArray As Variant, ByVal TargetCell As Range)TargetCell.Resize(UBound(TargetArray, 1), UBound(TargetArray, 2)).Value = TargetArrayEnd Sub' 调用示例Sub Demo_ArrayToRangeDim rg As Range, arr As VariantSet rg = shMarks.Range("A1").CurrentRegionarr = 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 VariantDim rg As Range, dataRg As RangeSet rg = TopLeft.CurrentRegion ' 整块Set dataRg = rg.Offset(HeaderRows, 0).Resize(rg.Rows.Count - HeaderRows) ' 下移去头，行数-头部GetCurrentRegionData = dataRg.ValueEnd Function' 调用示例Sub Demo_GetCurrentRegionDataDim sales As Variantsales = 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_WriteOutDim sales As Variant, outputArray As VariantDim i As Long, j As Long, outputRow As LongDim 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列是 SalesPersonIf sales(i, 2) = person ThenoutputRow = outputRow + 1' 逐列复制整行For j = LBound(sales, 2) To UBound(sales, 2)outputArray(outputRow, j) = sales(i, j)Next jEnd IfNext i' 只写出“有效命中行”（可能少于预开大小）If outputRow > 0 ThenshMarks.Range("F2").Resize(outputRow, UBound(sales, 2)).Value = outputArrayElseshMarks.Range("F2").CurrentRegion.ClearContents ' 无数据时可选择清空原结果区End IfEnd 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 jEnd Sub' 使用封装的调用示例（对应上一节的筛选场景）Sub FilterInArray_WithHelpersDim sales As Variant, outputArray As VariantDim i As Long, outputRow As Long, person As Stringsales = GetCurrentRegionData(shMarks.Range("A1"), 1)person = shMarks.Range("K1").ValueArraySetSize outputArray, salesFor i = 1 To UBound(sales, 1)If sales(i, 2) = person ThenoutputRow = outputRow + 1ArrayCopyRow outputArray, outputRow, sales, iEnd IfNext iIf outputRow > 0 ThenshMarks.Range("F2").Resize(outputRow, UBound(sales, 2)).Value = outputArrayElseshMarks.Range("F2").CurrentRegion.ClearContentsEnd IfEnd Sub细致说明
通过封装：主流程只关注“业务意图”（条件判断与结果写出）；细节（尺寸一致性、列循环）统一在过程里管理。若在团队协作中推广这套封装，建议建立统一模块（如 modArrayUtils），集中维护。场景与目的
如果数据来源是“Excel 表（ListObject）”，可以直接用 DataBodyRange 获取数据体，避免自行偏移与裁剪。适用于你已将区域格式化为“表”的场景（在“表设计”中可查看表名）。Sub ReadFromTableBodyDim 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) 用心智模型把复杂业务拆解为“筛/聚/合”。来源：数据分析精选
