MyTetra Share
Делитесь знаниями!
Словарь словарей
Время создания: 16.03.2019 23:43
Раздел: Разные закладки - VBA - Dictionary-Collection
Запись: xintrea/mytetra_db_adgaver_new/master/base/1482223602e1f5lkx8fi/text.html на raw.githubusercontent.com

 

 

Public Sub DicProdTCM()

    Dim DatePJI As String

    Dim DatePJI2 As Date

    Dim i As Long

    Dim Ch As Integer

    Dim mainKey As Variant, childKey As Variant

    Set mainDict = CreateObject("Scripting.Dictionary")

   

'    On Error Resume Next

   

    NbCol = ShTemp.Cells(1, 256).End(xlToLeft).Column

    NbRow = ShTemp.Cells(65256, 1).End(xlUp).Row

   

    'Столбец с PJI

    NbColName = "PJI": NbColPJI = ShTemp.Rows(1).Find(What:=NbColName, LookAt:=xlWhole).Column

    'Столбец с Statut

    NbColName = "Statut": NbColSt = ShTemp.Rows(1).Find(What:=NbColName, LookAt:=xlWhole).Column

    'Столбец с Horodate

    NbColName = "Horodate": NbColTime = ShTemp.Rows(1).Find(What:=NbColName, LookAt:=xlWhole).Column

    'Столбец с Type de caisse

    NbColName = "Type de caisse": NbColType = ShTemp.Rows(1).Find(What:=NbColName, LookAt:=xlWhole).Column

   

    PJIArr = Range(ShTemp.Cells(2, 1), ShTemp.Cells(NbRow, NbCol)).Value

    Set childDict = Nothing

   

    DateFile = 0

   

    For i = 2 To NbRow

        If Trim(ShTemp.Cells(i, NbColSt)) <> "ND" Then

            

           

            DatePJI = Trim(ShTemp.Cells(i, NbColTime))

            a = Left(DatePJI, 2)

            B = Mid(DatePJI, 4, 2)

            c = Mid(DatePJI, 7, 4)

            d = Right(DatePJI, 8)

            DatePJI2 = a & "." & B & "." & c & " " & d

           

            'максимальная дата в файле

            If DateFile < DatePJI2 Then DateFile = DatePJI2

           

            mainKey = Format(DatePJI2, "DD.MM.YYYY")

            If mainDict.exists(mainKey) Then

                Set childDict = mainDict(mainKey)

               

            Else

                Set childDict = CreateObject("Scripting.Dictionary"): mainDict.Add mainKey, childDict

               

            End If

            childKey = ShTemp.Cells(i, NbColType) 'childDict(childKey) = Empty

           

            If childDict.exists(childKey) Then

                 Ch = childDict(childKey)

'                childDict.Add childKey, Ch + 1

                childDict(childKey) = Ch + 1

            Else

                childDict.Add childKey, 1

            End If

        End If

    Next i

 

    For Each mainKey In mainDict.Keys

        Set childDict = mainDict(mainKey)

 

        Debug.Print CStr(mainKey) & " <>: " & Join(childDict.Keys, "; ") & "|" & Join(childDict.Items, "; ")

    Next

   

    Set childDict = Nothing

End Sub

 

'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

 

    'выгрузить количество

    NbCol = ShTemp.Cells(1, 256).End(xlToLeft).Column

    NbRow = ShTemp.Cells(65256, 1).End(xlUp).Row + 1

    'цикл по словарю дат

    For Each mainKey In mainDict.Keys

        Set childDict = mainDict(mainKey)

        DatePJI = mainKey

       

        Debug.Print CStr(mainKey) & " <>: " & Join(childDict.Keys, "; ") & "|" & Join(childDict.Items, "; ")

        CountType = childDict.Count

        'цикл по внутреннему словарю

        For Each childKey In childDict.Keys

            ShTemp.Cells(NbRow, 1) = Year(DatePJI)

            ShTemp.Cells(NbRow, 2) = Month(DatePJI)

            ShTemp.Cells(NbRow, 3) = Application.WeekNum(DatePJI, 21)

            ShTemp.Cells(NbRow, 4) = DatePJI

           

            ShTemp.Cells(NbRow, 5) = childKey

            ShTemp.Cells(NbRow, 6) = childDict(childKey)

            NbRow = NbRow + 1

        Next childKey

       

    Next mainKey

 

 
MyTetra Share v.0.65
Яндекс индекс цитирования