словарь словарей

  Dim a(), i&, Dic As Object, Dic2 As Object, t$, x&, y&
    a = [a1:k20].Value
    Set Dic = CreateObject("Scripting.Dictionary"): Dic.CompareMode = 1
 
    For i = 1 To UBound(a)
        t = a(i, 11)
        If Not Dic.exists(t) Then 'если ещё нет ключа
 
            Set Dic2 = CreateObject("Scripting.Dictionary"): Dic2.CompareMode = 1 'создаём субсловарь
            Dic2.Add a(i, 8), New Collection 'с ключём и № строки
            Dic2.Item(a(i, 8)).Add i: Dic.Add t, Dic2
 
        Else 'если ключ есть
            Set Dic2 = Dic.Item(t) 'извлекаем субсловарь
            
            If Not Dic2.exists(a(i, 8)) Then 'если в субсловаре нет субключа
                Dic2.Add a(i, 8), New Collection 'добавляем субключ с коллекцией
            End If
            Dic2.Item(a(i, 8)).Add i 'добавляем № строки
            
            Set Dic.Item(t) = Dic2 'заносим субсловарь
        End If
    Next

        If Not oUL_Dp.exists(t) Then 'если ещё нет ключа
            Set DP = CreateObject("Scripting.Dictionary"): DP.CompareMode = 1 'создаём субсловарь
            DP(domd) = r
            Set oUL_Dp(t) = DP
        Else 'если ключ есть
            oUL_Dp(t)(domd) = r
        End If

Sub PereborFailov2() ' словарь в словаре
    Dim a, i&, t$, Dic As Object, Dic2 As Object
    Dim el, col
    
    a = Range("C3", Cells(Rows.Count, "A").End(xlUp)).Value
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        .CompareMode = 1
        For i = 1 To UBound(a)
            t = a(i, 1)
            If Not .exists(t) Then .Add t, CreateObject("Scripting.Dictionary")
            .Item(t).Item(a(i, 2) & "|" & a(i, 3) & "|" & i) = 0&
            
        Next
    End With
    
    For Each el In Dic.keys
        Debug.Print "Открываем файл " & el
        Set Dic2 = Dic.Item(el)
        For Each col In Dic2.keys
            Debug.Print "Ищем данные " & col '& "|" & Dic2.Item(col)
        Next
        Debug.Print "Закрываем файл " & el
    Next
 
End Sub

For c = 1 To lcp
     If InStr(1, .Cells(c, r), ndz, vbTextCompare) > 0 Then
         With shi
         ky = .Cells(c, 2).Value
         it = .Cells(c, 6).Value
         End With
          t = nsh
          If Not Dic.exists(t) Then
          Set Dic2 = CreateObject("Scripting.Dictionary"): Dic2.CompareMode = 1
          Dic2(ky) = it
          Set Dic(t) = Dic2
          Else
          Dic(t)(ky) = it
          End If                                        
     End If
Next c

Debug.Print "Ищем данные " & col '& "|" & Dic2.Item(col)