VBA中Dictionary存储ArrayList数据丢失问题及解决方案咨询

你推测的完全正确——问题根源在于ArrayList是引用类型。你只创建了一个arrListToDict对象，每次循环将它添加到字典后调用Clear，字典里所有的Item其实都是指向同一个ArrayList实例的引用，最终所有条目都会变成空的。

下面提供几种可行的解决办法：

方案1：每次循环新建ArrayList实例 #

不再复用同一个ArrayList，每次循环创建独立的对象，确保字典每个条目对应唯一的实例：

Function myDict() As Object
    Dim dict As Object, keyList As Object, arrListToDict As Object
    Dim keyListCount As Long, iLoop As Long
    Dim dateToday As Date, date1 As Date, date2 As Date
    
    Set dict = CreateObject("Scripting.Dictionary")
    Set keyList = CreateObject("System.Collections.ArrayList")
    
    keyList.Add "Hey"
    keyList.Add "Hello"
    keyListCount = keyList.Count
    dateToday = Date

    For iLoop = 0 To keyListCount - 1
        ' 每次循环新建ArrayList实例
        Set arrListToDict = CreateObject("System.Collections.ArrayList")
        date1 = DateAdd("d", Int(20000 * Rnd), dateToday)
        date2 = DateAdd("d", Int(20000 * Rnd), dateToday)
        arrListToDict.Add date1
        arrListToDict.Add date2
        dict.Add key:=keyList(iLoop), Item:=arrListToDict
    Next iLoop
    
    Set myDict = dict
End Function

方案2：使用VBA原生数组（无需依赖ArrayList） #

直接用VBA内置的数组存储日期对，数组作为值类型传递，不会出现引用共享的问题：

Function myDict() As Object
    Dim dict As Object, keyList As Object
    Dim keyListCount As Long, iLoop As Long
    Dim dateToday As Date, date1 As Date, date2 As Date
    Dim datePair As Variant
    
    Set dict = CreateObject("Scripting.Dictionary")
    Set keyList = CreateObject("System.Collections.ArrayList")
    
    keyList.Add "Hey"
    keyList.Add "Hello"
    keyListCount = keyList.Count
    dateToday = Date

    For iLoop = 0 To keyListCount - 1
        date1 = DateAdd("d", Int(20000 * Rnd), dateToday)
        date2 = DateAdd("d", Int(20000 * Rnd), dateToday)
        ' 创建包含两个日期的数组
        datePair = Array(date1, date2)
        dict.Add key:=keyList(iLoop), Item:=datePair
    Next iLoop
    
    Set myDict = dict
End Function

调用时通过dict("Hey")(0)和dict("Hey")(1)即可获取对应的两个日期。

方案3：使用VBA Collection #

用Collection存储日期对，同样每次循环新建独立的Collection：

Function myDict() As Object
    Dim dict As Object, keyList As Object, dateCol As Collection
    Dim keyListCount As Long, iLoop As Long
    Dim dateToday As Date, date1 As Date, date2 As Date
    
    Set dict = CreateObject("Scripting.Dictionary")
    Set keyList = CreateObject("System.Collections.ArrayList")
    
    keyList.Add "Hey"
    keyList.Add "Hello"
    keyListCount = keyList.Count
    dateToday = Date

    For iLoop = 0 To keyListCount - 1
        Set dateCol = New Collection
        date1 = DateAdd("d", Int(20000 * Rnd), dateToday)
        date2 = DateAdd("d", Int(20000 * Rnd), dateToday)
        dateCol.Add date1
        dateCol.Add date2
        dict.Add key:=keyList(iLoop), Item:=dateCol
    Next iLoop
    
    Set myDict = dict
End Function

调用时用dict("Hey")(1)和dict("Hey")(2)获取日期（Collection索引从1开始）。

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