即使在 excel 关闭后存储/保存字典

Question

我有一个字典，其中包含用户密钥 ->用户名引用。(我正在使用它来存储基于当前用户密钥在Windows目录中查找用户名后，因为我认为这是一个非常缓慢的过程，并且希望提高性能(

如果我在搜索中做对了，当我重新打开 excel 文件时，我的字典会被完全清除，对吗？

所以我想把它保存到其中一个工作表中，我想在下一个会话中重新创建它。(一列应保存用户密钥，另一列应保存名称(。

我的代码运行，但不在字段中写入任何值：

'will store the values on the rule sheets in row 4 following, columns BA and BB
Sub SaveDictToRulesSheet(dict As Object)
'startrow of list on excel sheet
startrow = 4
Dim i As Integer
i = 0
ActiveSheet.Name = "Rules"
        For Each key In dict.Keys
        Worksheets("Rules").Cells(startrow + i, "BA").Value = key
        Worksheets("Rules").Cells(startrow + i, "BB").Value = dict(key)
        i = i + 1
        Next key
i = 0
End Sub

任何帮助将不胜感激。

Answer 1

所以我想把它保存到其中一个工作表中，我想在下一个会话中重新创建它。(一列应保存用户密钥，另一列应保存名称(。

嗯，这部分似乎很简单。有点令人困惑的是你在字典中读到的地方。你参考它，但我不清楚值被加载到哪里。我将向你们展示我将如何做到这一点。希望这有所帮助，我已经正确理解了这个问题。

将字典列写入空白/当前工作簿并保存。然后创建一个新的 sub 来操作如下内容：

Sub Retrieve_Dict()
    Set wbkCSV = Workbooks.Open("Template.xlsx")
    Set wshCSV = wbkCSV.Worksheets("Rules")
    Set dict = CreateObject("Scripting.Dictionary")
    numrows = application.worksheetfunction.counta(wshCSV.Columns(27)) - 5
    numcols = 2
    set wshRange = wshCSV.Range("BA5").Resize(numrows,numcols)
    tempArray = wshRange.value
    for i = 1 to ubound(tempArray) ' Read rows, columns, send to dict.
        dict.key(tempArray(i, 1)) = tempArray(i, 2)' read values.
    Next i
    tempArray = Process(dict)  ' Func. updating dictionary values. 
    wshRange.value = tempArray
    wbkCSV.Close (True)
End Sub

当然，如果您打开外面的工作簿，然后传递工作表，则可以使上述子成为函数。该函数可以作为对象/脚本字典返回，具体取决于您的绑定。

另外，请注意，我可能弄错了偏移量/行数。但我认为，一般原则应该适用。

Answer 2

下面的代码：

• TestDictionaryOps() - 测试从工作表中写入和读取
• DictionaryToRange() - 将字典写入工作表
• DictionaryFromRange() - 从工作表中读取字典

将其粘贴到新的标准模块中，然后在新工作表上运行它(Sheet4(

<小时 />

Option Explicit
Public Sub TestDictionaryOps()
    Dim d As Dictionary
    Set d = New Dictionary
    d("1") = "a"
    d("2") = "b"
    d("3") = "c"
    DictionaryToRange d, Sheet4
    Set d = DictionaryFromRange(Sheet4)
    If Not d Is Nothing Then MsgBox "Total Dictionary items: " & d.Count
End Sub

<小时 />

Public Sub DictionaryToRange(ByRef d As Dictionary, _
                             ByRef ws As Worksheet, _
                             Optional ByVal startCol As Long = 1)
    If Not d Is Nothing And Not ws Is Nothing And startCol > 0 Then
        Dim cnt As Long, rng1 As Range, rng2 As Range
        cnt = d.Count
        If cnt > 0 Then
            Set rng1 = ws.Range(ws.Cells(1, startCol + 0), ws.Cells(cnt, startCol + 0))
            Set rng2 = ws.Range(ws.Cells(1, startCol + 1), ws.Cells(cnt, startCol + 1))
            rng1 = Application.Transpose(d.Keys)    'write all keys to column 1
            rng2 = Application.Transpose(d.Items)   'write all items to column 2
        Else
            MsgBox "Empty Dictionary"
        End If
    Else
        MsgBox "Missing Dictionary or WorkSheet"
    End If
End Sub

<小时 />

Public Function DictionaryFromRange(ByRef ws As Worksheet, _
                                    Optional ByVal startCol As Long = 1) As Dictionary
    If Not ws Is Nothing And startCol > 0 Then
        Dim d As Dictionary, cnt As Long, vArr As Variant, i As Long
        Set d = New Dictionary
        cnt = ws.UsedRange.Columns(startCol).Cells.Count
        vArr = ws.Range(ws.Cells(1, startCol), ws.Cells(cnt, startCol + 1)).Value2
        For i = 1 To cnt
            d(vArr(i, startCol)) = vArr(i, startCol + 1)
        Next
        Set DictionaryFromRange = d
    Else
        MsgBox "Missing WorkSheet"
    End If
End Function

<小时 />

早期绑定(快速(：VBA 编辑器 ->工具 -> 引用 -> 添加Microsoft脚本运行时

后期绑定(慢速(：CreateObject("Scripting.Dictionary"(

<小时 />