Question

我有一本字典，其中包含用户密钥 - ＆gt;用户名参考。（我根据当前的用户密钥在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 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

当然，如果您在外面打开工作簿，然后传递工作表，则可以使上面的子函数成为函数。该函数可以作为Object / Scripting.Dictionary返回，具体取决于您的绑定。

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

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编辑器 - ＆gt;工具 - ＆gt;参考文献 - ＆gt;添加 Microsoft Scripting Runtime

后期绑定（慢）：CreateObject（＆＃34; Scripting.Dictionary＆＃34;）

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

2 个答案: