VBA中如何通过For循环将工作表数组存储到Dictionary中

原有代码问题 #

• 字典声明不符合需求：你原先声明的是Dictionary()数组，我们只需要单个字典对象，用数组名作为键存储对应数据即可，不需要数组形式的字典。
• 依赖Activate/Select方法：这类写法运行效率低，且容易因操作焦点偏移触发异常，建议直接通过单元格引用操作。

修正后完整代码 #

Sub 批量存数组到字典()
    ' 变量声明
    Dim dataDict As Object
    Dim startRow As Long, endRow As Long, arrColCount As Long, colGap As Long
    Dim currNameCol As Long, arrName As String, arrData As Variant
    
    ' 初始化字典
    Set dataDict = CreateObject("Scripting.Dictionary")
    
    ' 自定义配置参数，可根据实际需求调整
    startRow = 27 ' 单个数组的起始行
    endRow = 36 ' 单个数组的结束行
    arrColCount = 11 ' 单个数组占的列数
    colGap = 13 ' 两个数组之间的列间距
    currNameCol = 10 ' 第一个数组名称所在列：J列对应列号10
    
    ' 循环读取所有数组
    Do
        ' 读取当前数组名称
        arrName = Sheets("Sheet1").Cells(3, currNameCol).Value
        ' 名称为空直接停止
        If arrName = "" Then Exit Do
        
        ' 读取数组区域内容
        arrData = Sheets("Sheet1").Range( _
            Sheets("Sheet1").Cells(startRow, currNameCol + 1), _
            Sheets("Sheet1").Cells(endRow, currNameCol + arrColCount) _
        ).Value
        ' 数组为空停止
        If IsEmpty(arrData) Then Exit Do
        
        ' 存入字典，重复名称默认跳过
        If Not dataDict.Exists(arrName) Then
            dataDict.Add arrName, arrData
        End If
        
        ' 偏移到下一个数组的名称列
        currNameCol = currNameCol + arrColCount + colGap
    Loop
    
    ' 下方可添加字典的后续使用逻辑，示例为遍历输出验证
    ' Dim key As Variant
    ' For Each key In dataDict.Keys
    '     Debug.Print "数组名：" & key, "行数：" & UBound(dataDict(key), 1), "列数：" & UBound(dataDict(key), 2)
    ' Next
End Sub

逻辑说明 #

• 自动停止逻辑：循环时会依次判断数组名称、数组内容是否为空，任意一项为空就自动终止运行，符合你的需求。
• 兼容性优化：使用CreateObject创建字典，不需要提前引用Microsoft Scripting Runtime库，不同版本Office都可以直接运行。
• 可扩展性强：所有核心参数都放在开头的配置区，后续数组尺寸、间距变化只需要修改对应参数即可，不需要调整循环逻辑。

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