VBA合并字典匹配值异常：修复代码与货币对应查找问题

核心问题分析 #

原代码存在以下关键错误导致无法通过代码找到对应货币：

• 变量名不匹配：定义了propertyCode、baseCurrency，但代码中错误使用未定义的Code、Currency变量
• 主字典D_Dict未初始化，且未预先创建"Code"键就直接调用D_Dict("Code")
• S_Keys的关联逻辑错误，未建立代码→货币的直接映射，反而用拼接字符串作为键
• 未初始化dict变量，且错误使用未定义的Name变量（应为propertyName）

修复后的完整代码 #

Sub FixDictionaryMapping()
    Dim W_Wbs As Workbook
    Dim W_Curr As Worksheet, W_Property As Worksheet, wsPackage As Worksheet
    Dim tblAttributes As ListObject
    Dim i As Integer
    
    ' 初始化工作簿、工作表和表格对象（需确保wsPackage、tblAttributes已正确赋值）
    Set W_Wbs = ActiveWorkbook
    Set W_Curr = W_Wbs.Sheets("2a")
    Set W_Property = W_Wbs.Sheets("2b")
    ' 假设wsPackage是你需要引用的工作表，需根据实际情况赋值
    Set wsPackage = W_Wbs.Sheets("你的工作表名称")
    ' 假设tblAttributes是W_Property中的表格，需根据实际情况赋值
    Set tblAttributes = W_Property.ListObjects("tblAttributes")
    
    ' 初始化三个核心字典
    Dim Codes As Object, Currencies As Object, S_Keys As Object
    Set Codes = CreateObject("Scripting.Dictionary")
    Set Currencies = CreateObject("Scripting.Dictionary")
    Set S_Keys = CreateObject("Scripting.Dictionary")
    
    ' 初始化原代码中的D_Dict和dict（如果需要保留原有逻辑）
    Dim D_Dict As Object, dict As Object
    Set D_Dict = CreateObject("Scripting.Dictionary")
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 预先创建D_Dict的子字典
    Set D_Dict("Code") = CreateObject("Scripting.Dictionary")
    Set D_Dict("Currency") = CreateObject("Scripting.Dictionary")
    Set D_Dict("Keys") = CreateObject("Scripting.Dictionary")
    Set D_Dict("Name") = CreateObject("Scripting.Dictionary")
    
    For i = 1 To tblAttributes.DataBodyRange.Rows.Count
        Dim propertyName As String
        Dim propertyCode As String
        Dim baseCurrency As String
        
        ' 正确读取表格中的值
        propertyName = tblAttributes.DataBodyRange.Cells(i, tblAttributes.ListColumns("Name").Index).Value
        propertyCode = tblAttributes.DataBodyRange.Cells(i, tblAttributes.ListColumns("Code").Index).Value
        baseCurrency = tblAttributes.DataBodyRange.Cells(i, tblAttributes.ListColumns("Currency").Index).Value
        
        ' 检查wsPackage第4列是否存在当前propertyName
        If Application.CountIf(wsPackage.Columns(4), propertyName) > 0 Then
            ' 建立代码到货币的直接映射（S_Keys核心需求）
            If Not S_Keys.Exists(propertyCode) Then
                S_Keys.Add propertyCode, baseCurrency
                ' 同时维护Codes和Currencies字典（如果需要单独存储）
                If Not Codes.Exists(propertyCode) Then Codes.Add propertyCode, propertyCode
                If Not Currencies.Exists(baseCurrency) Then Currencies.Add baseCurrency, baseCurrency
            End If
            
            ' 修复D_Dict的子字典操作（使用正确的变量名）
            If Not D_Dict("Code").Exists(propertyCode) Then
                Set D_Dict("Code")(propertyCode) = CreateObject("Scripting.Dictionary")
            End If
            If Not D_Dict("Currency").Exists(baseCurrency) Then
                Set D_Dict("Currency")(baseCurrency) = CreateObject("Scripting.Dictionary")
            End If
            Dim sKey As String
            sKey = propertyCode & "¦" & baseCurrency
            If Not D_Dict("Keys").Exists(sKey) Then
                Set D_Dict("Keys")(sKey) = CreateObject("Scripting.Dictionary")
            End If
            If Not D_Dict("Name").Exists(propertyName) Then
                Set D_Dict("Name")(propertyName) = CreateObject("Scripting.Dictionary")
            End If
        End If
        
        ' 修复dict的逻辑（使用正确的变量名）
        If Not dict.Exists(propertyName) Then
            dict.Add propertyName, Array(propertyCode, baseCurrency)
        Else
            Dim existingValues As Variant
            existingValues = dict(propertyName)
            ReDim Preserve existingValues(0 To UBound(existingValues) + 2)
            existingValues(UBound(existingValues) - 1) = propertyCode
            existingValues(UBound(existingValues)) = baseCurrency
            dict(propertyName) = existingValues
        End If
    Next i
    
    ' 测试：通过代码获取对应货币
    Dim testCode As String
    testCode = "你的测试代码" ' 替换为实际存在的代码
    If S_Keys.Exists(testCode) Then
        MsgBox "代码" & testCode & "对应的货币是：" & S_Keys(testCode)
    Else
        MsgBox "未找到代码" & testCode & "对应的货币"
    End If
End Sub

关键修复说明 #

1. 变量名统一：全程使用定义好的propertyName、propertyCode、baseCurrency，避免未定义变量导致的空值错误
2. 字典初始化：所有Scripting.Dictionary对象都提前用CreateObject初始化，避免运行时错误
3. S_Keys核心映射：直接建立propertyCode作为键，baseCurrency作为值的映射，满足"已知代码找货币"的需求
4. D_Dict结构修复：预先创建"Code"等子字典，避免调用未存在的键时出错
5. 添加测试逻辑：最后加入测试代码，验证通过代码获取货币的功能是否正常

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