MyTetra Share
Делитесь знаниями!
Словарь словарей
20.12.2016
11:46
Раздел: VBA - Dictionary


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.52
Яндекс индекс цитирования