Excel VBA 为多组库存编号对应序列号数组批量定义命名范围及下拉列表

• 卡顿原因：原代码采用双层循环逻辑，每处理分表的一行数据，就全量遍历一次总表所有行，时间复杂度为O(分表行数×总表行数)，数据量较大时会出现明显卡顿；同时UsedRange会统计带有格式的历史空行，额外增加无效循环次数。
• 1004报错原因：Excel数据有效性的列表类型要求Formula1参数不能是空值，且逗号拼接的字符串总长度不能超过255个字符；如果某库存编号没有对应序列号，或者对应序列号拼接后长度超限，都会触发该报错。

采用字典预处理总表数据，仅遍历一次总表即可完成所有库存编号和对应序列号的映射，同时直接使用单元格区域作为数据有效性来源，不受255字符限制，同时添加边界判断避免处理空行。

完整代码 #

Private Sub CommandButton2_Click()
    ' 声明变量
    Dim wsALFA As Worksheet: Set wsALFA = Sheets("ALFA") ' 分表
    Dim wsSTORAGE As Worksheet: Set wsSTORAGE = Sheets("STORAGE") ' 总表
    Dim dict As New Scripting.Dictionary ' 存储库存编号对应序列号的区域
    Dim lastRowStorage As Long, lastRowALFA As Long
    Dim i As Long, stockCode As String
    Dim rngSerial As Range
    
    ' 关闭屏幕刷新、事件，加快运行速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' ========== 第一步：预处理总表数据，存入字典 ==========
    lastRowStorage = wsSTORAGE.Cells(Rows.Count, "C").End(xlUp).Row
    For i = 2 To lastRowStorage
        stockCode = CStr(wsSTORAGE.Cells(i, "C").Value)
        ' 跳过空的库存编号
        If stockCode <> "" Then
            ' 如果字典中不存在该编号，新增key并绑定序列号单元格
            If Not dict.Exists(stockCode) Then
                Set dict(stockCode) = wsSTORAGE.Cells(i, "D")
            Else
                ' 已存在则合并单元格区域
                Set dict(stockCode) = Union(dict(stockCode), wsSTORAGE.Cells(i, "D"))
            End If
            ' 同时创建/更新命名范围，符合原始需求
            ThisWorkbook.Names.Add Name:=stockCode, RefersTo:=dict(stockCode)
        End If
    Next i
    
    ' ========== 第二步：给分表添加数据有效性 ==========
    lastRowALFA = wsALFA.Cells(Rows.Count, "C").End(xlUp).Row
    For i = 2 To lastRowALFA
        stockCode = CStr(wsALFA.Cells(i, "C").Value)
        ' 清空原有有效性
        wsALFA.Cells(i, "D").Validation.Delete
        ' 仅当库存编号存在对应序列号时添加有效性
        If stockCode <> "" And dict.Exists(stockCode) Then
            wsALFA.Cells(i, "D").Validation.Add _
                Type:=xlValidateList, _
                AlertStyle:=xlValidAlertStop, _
                Formula1:="=" & stockCode ' 直接引用提前创建好的命名范围
        End If
    Next i
    
    ' 恢复设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Set dict = Nothing
End Sub

使用说明 #

• 如运行提示「用户定义类型未定义」，可采用两种方式解决：
  1. 前期绑定：打开VBA编辑器，点击「工具」-「引用」，勾选「Microsoft Scripting Runtime」即可
  2. 后期绑定：将代码中Dim dict As New Scripting.Dictionary替换为Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
• 代码同时实现了原始需求的「为每个库存编号分配命名范围」的要求，命名范围和数据有效性引用联动，总表更新后重新运行宏即可同步更新。
• 优化后代码仅需遍历总表和分表各一次，时间复杂度为O(总表行数+分表行数)，运行速度提升明显。

内容的提问来源于stack exchange，提问作者Lan4eg