代码之家 › 专栏 › 技术社区 › VBA.starter

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

insert-into cell excel vba

VBA.starter · 技术社区 · 7 年前

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

非常感谢您的帮助。

2 回复 | 直到 6 年前

Dave Reilly 7 年前

因此,我想将其保存到其中一张工作表中,以便在下一个会话中重新创建它。(一列应包含用户密钥,另一列应包含名称)。

这部分看起来很简单。有点让人困惑的是,你在dict中读到了什么。你提到了它,但我不清楚这些值是在哪里加载的。我要告诉你我会怎么做。希望这会有所帮助,我已经正确理解了这个问题。

将字典列写入空白/当前工作簿并保存。然后创建一个新的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

当然,如果您在外部打开工作簿,然后传递工作表,则可以将上述子项设置为函数。该函数可以作为对象/脚本返回。字典取决于您的绑定。

此外,请注意,我可能得到了偏移/行计数错误。但我认为,一般原则应该适用。

Community CDub 5 年前

以下代码:

TestDictionaryOps() -测试纸张的书写和阅读
DictionaryToRange() -将字典写入工作表
DictionaryFromRange() -从工作表中读取词典

将其粘贴到新的标准模块中,并在新的工作表上运行(表4)

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

早期绑定(fast) :VBA编辑器->工具->参考资料->添加 Microsoft脚本运行时

延迟绑定(慢速) :CreateObject(“Scripting.Dictionary”)