Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


43920 / 76732 ←次へ | 前へ→

【37838】Re:集計について
発言  ponpon  - 06/5/20(土) 2:04 -

引用なし
パスワード
   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

0 hits

【37828】集計について ねこ 06/5/19(金) 17:28 質問
【37835】Re:集計について AMEYakyu 06/5/19(金) 21:28 発言
【37838】Re:集計について ponpon 06/5/20(土) 2:04 発言
【37858】Re:集計について Hirofumi 06/5/21(日) 8:01 発言

43920 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free