| |
Dictionaryの練習用に一応作ってみました。
もっといい方法があると思います。
書き出しが何かどんくさいです。
出力の形式がいまいち分からなかったので
勝手にこっちでやってます。
参考にしてください。
Sub test()
Dim myDic1 As Object
Dim myDic2 As Object
Dim myDic3 As Object
Dim myKeys1, myKeys2, myKeys3
Dim myItems1, myItems2, myItems3
Dim myR As Range
Dim r As Range
Dim I As Long
With Sheets("作業用")
Set myDic1 = CreateObject("Scripting.Dictionary")
Set myDic2 = CreateObject("Scripting.Dictionary")
Set myDic3 = CreateObject("Scripting.Dictionary")
Set myR = .Range("B2", .Range("B65536").End(xlUp))
For Each r In myR
myDic1(r.Value) = myDic1(r.Value) + r.Offset(, 6).Value
myDic2(CStr(r.Value) & "&" & CStr(r.Offset(, 1).Value)) = myDic2(CStr(r.Value) & "&" & CStr(r.Offset(, 1).Value)) + r.Offset(, 6).Value
myDic3(r.Offset(, 7).Value) = myDic3(r.Offset(, 7).Value) + r.Offset(, 6).Value
Next
End With
With Sheets("作業用(一覧)")
.Cells.ClearContents
.Range("A1").Value = "大分類別売上": .Range("D1").Value = "大分類＆小分類別売上": .Range("G1").Value = "曜日別売上"
myKeys1 = myDic1.keys
myItems1 = myDic1.items
For I = 0 To myDic1.Count - 1
.Cells(I + 2, 1).Value = myKeys1(I)
.Cells(I + 2, 2).Value = myItems1(I)
Next
.Range("A65536").End(xlUp).Offset(1).Value = "件数"
.Range("A65536").End(xlUp).Offset(, 1).Value = myDic1.Count
myKeys2 = myDic2.keys
myItems2 = myDic2.items
For I = 0 To myDic2.Count - 1
.Cells(I + 2, 4).Value = myKeys2(I)
.Cells(I + 2, 5).Value = myItems2(I)
Next
.Range("D65536").End(xlUp).Offset(1).Value = "件数"
.Range("D65536").End(xlUp).Offset(, 1).Value = myDic2.Count
myKeys3 = myDic3.keys
myItems3 = myDic3.items
For I = 0 To myDic3.Count - 1
.Cells(I + 2, 7).Value = myKeys3(I)
.Cells(I + 2, 8).Value = myItems3(I)
Next
End With
End Sub
|
|
ponpon
- 06/5/20(土) 2:04 -
