尝试创建一个以其他字典作为值的字典，而前面提到的解决方案不起作用

Question

我要创建的结构是 DictionaryMain -> Dictionary1, Dictionary2, ... -> Array1Dict1, Array2Dict1, Array1Dict2, Array2Dict2, ...

    Dim Range1 As Range
    Set Range1 = Range("O2:O230")
    Dim Range2 As Range
    Set Range2 = Range("P2:P230")
    Dim Range3 As Range
    Set Range3 = Range("A2:N800")
    SelectedValue = Range("Q2").Value
    Dim DictMain As Object
    Set DictMain = CreateObject("scripting.dictionary")
    i = 1
    For Each Row In Range1.Rows
        If Not IsEmpty(Row.Cells(1).Value) Then
            If Not DictMain.Exists(Row.Cells(1).Value) Then
                Dim dict
                Set dict = CreateObject("Scripting.Dictionary")
                dict.Add Range2.Rows(i).Cells(1).Value, Array(i, 0, "", SelectedValue, 100)
                DictMain.Add Row.Cells(1).Value, dict
                i = i + 1
            Else
                DictMain(Row.Cells(1).Value).Add Range2.Rows(i).Cells(1).Value, Array(i, 0, "", SelectedValue, 100)
                i = i + 1
            End If
        Else: Exit For
        End If
    Next Row
    For Each Key In DictMain.Keys()
        For Each Row In Range3.Rows
            If Not IsEmpty(Row.Cells(11).Value) And Not IsEmpty(Row.Cells(13).Value) Then
                If Row.Cells(11).Value = Row.Cells(13).Value Then
                Else
                    If Not DictMain(Key).Exists(Row.Cells(11).Value) Then
                        DictMain(Key).Add Row.Cells(11).Value, Array(DictMain(Key).Item(Row.Cells(13).Value)(0), Row.Cells(14).Value, Row.Cells(13).Value, 0, 0)
                        val1 = DictMain(Key).Item(Row.Cells(13).Value)(3)
                        val2 = DictMain(Key).Item(Row.Cells(13).Value)(4)
                        val1 = val1 + DictMain(Key).Item(Row.Cells(11).Value)(1)
                        DictMain(Key).Item(Row.Cells(11).Value)(3) = DictMain(Key).Item(Row.Cells(11).Value)(1)
                        DictMain(Key).Item(Row.Cells(11).Value)(4) = val2
                        DictMain(Key).Item(Row.Cells(13).Value)(3) = val1
                        val1 = DictMain(Key).Item(Row.Cells(11).Value)(3)
                        val2 = DictMain(Key).Item(Row.Cells(11).Value)(4)
                        val2 = SelectedValue * val1 / val2
                        val1 = SelectedValue
                        DictMain(Key).Item(Row.Cells(11).Value)(3) = val1
                        DictMain(Key)(Row.Cells(11).Value)(4) = val2
                    Else
                        Exit For
                    End If
                End If
            Else: Exit For
            End If
        Next Row
    Next Key

我收到“运行时错误 424：需要对象”。错误发生在

val2 = SelectedValue * val1 / val2

行。 Val2 和 val1 都是 0。DictMain 只有 Variant/String 条目。

我已经尝试过其他类似问题中所述的解决方案，但没有成功。我该如何解决这个问题？

Answer 1

未经测试，但建议像这样以避免在数组存储在字典中时尝试更新数组的问题：

Sub Tester()
    Dim arr, arrData, ws As Worksheet, DictMain As Object, r As Long
    Dim vO, vP, key, vK, vM, dictSub As Object, i As Long, vMArr, vKArr
    Dim SelectedValue, val1, val2
    
    Set ws = ActiveSheet   'always be explicit about what sheet you're working with
    'more efficient to read a whole range in one shot
    arr = ws.Range("O2:P230").Value 
    arrData = ws.Range("A2:N800")
    
    Set DictMain = CreateObject("scripting.dictionary")
    For r = 1 To UBound(arr)
        vO = arr(r, 1)
        vP = arr(r, 2)
        If Len(vO) > 0 Then
            i = i + 1
            If Not DictMain.Exists(vO) Then DictMain.Add vO, CreateObject("Scripting.Dictionary")
            DictMain(vO).Add vP, Array(i, 0, "", SelectedValue, 100)
        End If
    Next r
    
    For Each key In DictMain.Keys()
        Set dictSub = DictMain(key) 'reference the sub-dictionary
        For r = 1 To UBound(arrData)
            vK = arrData(r, 11) 'ColK value
            vM = arrData(r, 13) 'ColM value
            'perform some checks
            If Len(vK) = 0 Or Len(vM) = 0 Or vK = vM Then Exit For
            If dictSub.Exists(vK) Then Exit For
            
            vMArr = dictSub(vM)  'pull out the array
            vKArr = Array(vMArr(0), arrData(r, 14), vM, 0, 0) 'don't add the new one yet....
            
            val1 = vMArr(3)
            val2 = vMArr(4)
            val1 = val1 + vKArr(1)
            vKArr(3) = vKArr(1)
            vKArr(4) = val2
            
            vMArr(3) = val1
            
            val1 = vKArr(3)
            val2 = vKArr(4)
            val2 = SelectedValue * val1 / val2
            val1 = SelectedValue
            vKArr(3) = val1
            vKArr(4) = val2
            
            dictSub.Add vK, vKArr 'add the new key and array array
            dictSub(vM) = vMArr   'return updated array
        Next r
    Next key

End Sub