Excel VBA質問箱 IV

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

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


6826 / 13644 ツリー ←次へ | 前へ→

【42892】Dictionaryを使用して集計 Sinzin 06/9/24(日) 18:58 質問[未読]
【42900】Re:Dictionaryを使用して集計 ichinose 06/9/25(月) 6:28 発言[未読]
【42901】Re:Dictionaryを使用して集計 Sinzin 06/9/25(月) 7:11 お礼[未読]
【42902】Re:Dictionaryを使用して集計 ichinose 06/9/25(月) 7:54 発言[未読]
【42903】Re:Dictionaryを使用して集計 Sinzin 06/9/25(月) 7:59 お礼[未読]
【42904】Re:Dictionaryを使用して集計 Blue 06/9/25(月) 8:49 発言[未読]

【42892】Dictionaryを使用して集計
質問  Sinzin  - 06/9/24(日) 18:58 -

引用なし
パスワード
    日付   品名  単価 数量  金額
2006/1/15 DPV200 230  123  28,280
2006/1/20 DPV200 230  36   8,280
2006/2/10 DZ3000 980  216  211,680
2006/2/15 DPV200 230  279  64,170
2006/2/20 DPV200 230  325  74,750

というデータを月別、品名別に数量と金額を合計した集計表
       2006/1    2006/2    ・・・
    数量計 金額計 数量計 金額計
DPV200  159  36,560  604  138,920
DZ3000  ・・ ・・・・ ・・ ・・・・

を作成したいと思っています。
Dictionaryの使い方を覚えたいと思っていますので、Dictionary
を使った方法を教えてください。

【42900】Re:Dictionaryを使用して集計
発言  ichinose  - 06/9/25(月) 6:28 -

引用なし
パスワード
   ▼Sinzin さん:
こんばんは。
以下のデータがシートSheet1のセルA1から
設定されているとすると、

> 日付   品名  単価 数量  金額
>2006/1/15 DPV200 230  123  28,280
>2006/1/20 DPV200 230  36   8,280
>2006/2/10 DZ3000 980  216  211,680
>2006/2/15 DPV200 230  279  64,170
>2006/2/20 DPV200 230  325  74,750
>


Sheet2というシート(Sheet2というシートを初期設定で用意しておいてください)
に以下のような結果を作成します。
>       2006/1    2006/2    ・・・
>    数量計 金額計 数量計 金額計
>DPV200  159  36,560  604  138,920
>DZ3000  ・・ ・・・・ ・・ ・・・・

標準モジュールに
'======================================================================
Option Explicit
Sub test()
  Dim idx As Long
  Dim wk As Variant
  Dim rng As Range
  Dim crng As Range
  Dim dic As Object
  Dim yyyymm As Variant
  Dim num_sum As Variant
  With Worksheets("sheet1")
    Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
    End With
  If rng.Row > 1 Then
    yyyymm = mk_unique_array(Application.Transpose(rng), "yyyy/m", 1)
    ReDim num_sum(LBound(yyyymm) To UBound(yyyymm) * 2 + 1)
    For idx = LBound(num_sum) To UBound(num_sum)
     num_sum(idx) = 0
     Next
    Set dic = CreateObject("scripting.dictionary")
    For Each crng In rng
     If Not dic.Exists(crng.Offset(0, 1).Value) Then
       dic.Add crng.Offset(0, 1).Value, num_sum
       End If
     With Application
       idx = .Match(Format(crng.Value, "yyyy/m"), yyyymm, 0) _
            + LBound(yyyymm) - 1
       wk = dic.Item(crng.Offset(0, 1).Value)
       wk(2 * idx) = wk(2 * idx) + crng.Offset(0, 3).Value
       wk(2 * idx + 1) = wk(2 * idx + 1) + crng.Offset(0, 4).Value
       dic.Item(crng.Offset(0, 1).Value) = wk
       End With
     Next crng
    With Worksheets("sheet2")
     For idx = LBound(yyyymm) To UBound(yyyymm)
       With .Range(.Cells(1, 2 * idx + 2), .Cells(1, 2 * idx + 3))
        .NumberFormatLocal = "@"
        .MergeCells = True
        .Value = yyyymm(idx)
        .HorizontalAlignment = xlCenter
        .Offset(1).Resize(, 2).Value = Array("数量", "金額")
        End With
       Next
     .Range("a3", .Cells(UBound(dic.Keys) + 3, "a")).Value = _
         Application.Transpose(dic.Keys)
     .Range("b3", .Cells(UBound(dic.Keys) + 3, UBound(num_sum) + 2)).Value = _
         Application.Transpose(Application.Transpose(dic.Items))
     End With
    Erase wk
    Erase yyyymm
    Erase num_sum
    Set dic = Nothing
    End If
End Sub
'======================================================================
Function mk_unique_array(ByVal InArray As Variant, _
       ByVal frm As String, Optional _
       ByVal do_sort As Long = 0) As Variant
'指定された配列をデータが重複しない配列にする。結果は指定された書式形式にする
' in  InArray 一次元配列
'   frm 書式
'   do_sort ソートの有無 0 無し 1 昇順 2 降順
’               (但し、1,2は、配列が数値の時)
' Out mk_unique_array 重複しないデータの配列
  Dim idx As Long
  Dim tmp As Variant
  Dim dic As Object
  Set dic = CreateObject("scripting.dictionary")
  For Each tmp In InArray
   If do_sort = 1 Then
     tmp = Application.Min(InArray)
   ElseIf do_sort = 2 Then
     tmp = Application.Max(InArray)
     End If
   If Not dic.Exists(Format(tmp, frm)) Then
     dic.Add Format(tmp, frm), ""
     End If
   InArray(Application.Match(tmp, InArray, 0) + _
       LBound(InArray) - 1) = ""
   Next
  mk_unique_array = dic.Keys
  Set dic = Nothing
End Function


testを実行してみてください。

>Dictionaryの使い方を覚えたいと思っていますので、Dictionary
>を使った方法を教えてください。

こういう集計はDictionary
より他に適当な方法がありそうですけどね!!

【42901】Re:Dictionaryを使用して集計
お礼  Sinzin  - 06/9/25(月) 7:11 -

引用なし
パスワード
   ありがとうございます。思っていた通りの集計ができました。
Dictionaryについて、勉強したいと思っています。
解りやすく解説等をしているHPか書籍はご存じないでしょうか。

【42902】Re:Dictionaryを使用して集計
発言  ichinose  - 06/9/25(月) 7:54 -

引用なし
パスワード
   ▼Sinzin さん:
>Dictionaryについて、勉強したいと思っています。

Dictionaryについては、Helpがありますよ!!
私は、Helpで間に合ってしまいましたが・・・。

又、VBEの「ツール」----「参照設定」にて、
「Microsoft Scripting Runtime」を参照設定すれば、

Sub test()
  Dim dic As Dictionary
  Set dic = CreateObject("scripting.dictionary")
  dic.
'と「.」を入力した時点でメンバー(メソッドやプロパティ)が表示されます  
End Sub

メソッドやプロパティが少ないオブジェクトなので
これだけで想像がついてしまいます。
私は、普段は参照設定を行って使っています。

>解りやすく解説等をしているHPか書籍はご存じないでしょうか。
どうしても詳しいサイトということなら、私は知りませんので
どなたか詳しいサイトをご存知でしたら、お願いします。

【42903】Re:Dictionaryを使用して集計
お礼  Sinzin  - 06/9/25(月) 7:59 -

引用なし
パスワード
   ありがとうございます。
まだ、配列の意味合いが理解できていないことが
Dictionaryがわからない理由だと思います。
がんばって勉強します。

【42904】Re:Dictionaryを使用して集計
発言  Blue  - 06/9/25(月) 8:49 -

引用なし
パスワード
   ▼Sinzin さん:
>解りやすく解説等をしているHPか書籍はご存じないでしょうか。
普通にMSDNでしょうか?
http://msdn.microsoft.com/library/ja/script56/html/jsobjDictionary.asp
(左のツリーからメソッド、プロパティを確認できます。)

こういうよくわからないオブジェクトは、まずはヘルプ(=MSDN)で調べてみましょう。
それでもわからない場合、Google等のWebサイト検索エンジンでキーワードを絞って検索します。
今回の場合「Scripting.Dictionary VBA CreateObject」をキーワードに探してみると、
ほかの掲示板や、サンプルが載っているサイトが見つかるでしょう。
それでも、わからない場合、なにがどのように理解できないのか詳細にして質問してください。
(単に何も調べないで、ワカラナイというのよくないです)

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