20170814xlVBA Part codename closing price transpose

Raw data:

Transpose effect:

Sub transformdata () Dim Rng As Range Dim Arr As Variant Dim Dic As Object Dim DCode As Object Dim dday as O Bject Set Dic = CreateObject ("Scripting.Dictionary") Set DCode = CreateObject ("Scripting.Dictionary") Set dday = CreateObject ("Scripting.Dictionary") with Sheets ("Wresstk") Endrow =. Cells (. Cells.Rows.Count, 1). End (Xlup). Row Set Rng =. Range ("A2:c" & endrow) Arr = Rng.value for i = LBound (arr) to UBound (arr) Key = F            Ormat (Arr (i, 1), "000000") dCode (key) = "" "Key = Format (arr (i, 2)," YYYY-MM-DD ") DDay (key) = "" Key = Format (arr (i, 1), "000000") & ";" & Format (arr (i, 2), "Yyyy-mm-dd"  ) Dic (Key) = ARR (i, 3) Next I End with with Sheets ("Result") i = 1 for each k in Dcode.keys i = i + 1. Cells (i, 1). Value = "'" & k Next k j = 1 for eachK in Dday.keys j = j + 1. Cells (1, j). Value = "'" & K Next K ' Exit Sub for m = 2 to I for n = 2 to J Key = Fo Rmat (. Cells (M, 1). Text) & ";" & Format (. Cells (1, N). Text, "Yyyy-mm-dd"). Cells (M, N).  Value = DIC (Key) next n next m End with Set Dic = Nothing Set DCode = Nothing Set dday = Nothing Set Rng = NothingEnd Sub

　　

20170814xlVBA Part codename closing price transpose