Storing/Saving 即使在 excel 关闭后的字典

Storing/Saving a dictionary even after excel is closed

我有一本字典,其中包含用户密钥 -> 用户名引用。 (我在根据当前用户密钥在 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

非常感谢任何帮助。

So I want to save it to one of the sheets, where I want to recreate it from on the next session. (one column should hold the userkey, the other the name).

好吧,那部分看起来相当简单。有点令人困惑的是您在字典中阅读的位置。你提到它,但我不清楚这些值被加载到哪里。我将向你展示我将如何做到这一点。希望这会有所帮助,并且我已经正确理解了这个问题。

将您的字典列写入空白/当前工作簿并保存。然后创建一个像这样操作的新子:

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

当然,如果您改为在外部打开工作簿,然后传递工作表,则可以使上述子函数成为函数。根据您的绑定,函数可以 return 作为对象/Scripting.Dictionary。

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

下面的代码:

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

将其粘贴到新的标准模块中,然后 运行 将其粘贴到新的 sheet(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

Early binding (fast): VBA Editor -> Tools -> References -> Add Microsoft Scripting Runtime

Late binding (slow): CreateObject("Scripting.Dictionary")