スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

Dictionary をダンダン 


う~~・・・・暑い!!
クーラーは無いので、窓開け&扇風機・・・・
先週の、あの雨は何だったんだ・・・
あれ以来、雨は降らず・・・・窓を開けていると、家中砂ぼこりだぁ~~


本題に戻って・・・
サブタイトル「 Dictionary の多段化 」をやってみる事に。

Dictionary って、キーとして値を放り込んで・・・出現順で、重複排除・・・こんなとき便利です。
例えば、
  Dim dic As Object
  Dim v As Variant

  Set dic = CreateObject("Scripting.Dictionary")
  For Each v In Array("A", "B", "A", "C", "B", "A")
    dic.Item(v) = Null
  Next
  Debug.Print Join(dic.Keys, ":")
ってやると、A:B:C が得られますね。
    dic.Item(v) = Null
の記述は、良く使うんですが・・・
出現順で、キーの重複を排除できれば良いので・・・・
    dic.Add v, Null
でも良いんですが、 dic.Item(v) = Null では、
・キー(v)があったら、値の更新
・キーがなかったら、キーを作って値を設定・・・・
キーがあろうが無かろうが・・・ドンドン放り込む・・・・値は何でもいい・・・・
とした時、Exists で判別して、なかったら Add する・・・この処理を記述するまでもないのか・・・

さぁて、ここでですが(Excel に限定する事ではありませんけど)、以下のデータがあったとします。

県名品物名購入者
青森りんご西田さん
青森りんご斉藤さん
青森りんご山田さん
愛媛キウイ島田さん
愛媛みかん石川さん
愛媛みかん佐藤さん
愛媛みかん田中さん
愛媛みかん小林さん
岩手うにアキちゃん
岩手うに夏さん
岩手うに春さん
岩手まめぶ安部ちゃん

「県名」「品物名」でグループ化して、購入者を横に羅列したい・・・・

県名品物名購入者1購入者2購入者3購入者4
青森りんご西田さん斉藤さん山田さん 
愛媛キウイ島田さん   
愛媛みかん石川さん佐藤さん田中さん小林さん
岩手うにアキちゃん夏さん春さん 
岩手まめぶ安部ちゃん   

Access では、クロス集計・・・・ソコソコ得たいものはできますが・・・・・
出現順を考え始めると・・・・Access では順を決定するオートナンバのフィールド等必要になりますね
ま、元のデータは Excel にあるものとして・・・

そこで、「県名」「品物名」を繋げたものをキーとして Dictionary に放り込む・・・
そのキーの値に、さらに Dictionary をぶち込んで「購入者」の出現順・重複排除・・・・
dic.Item(v) = CreateObject("Scripting.Dictionary")
では、
 実行時エラー '450'
 引数の数が一致していません。または不正なプロパティを指定しています。
のエラーになりますが、
dic.Add v, CreateObject("Scripting.Dictionary")
では、エラーにならないですね。

Excel での動きを確かめてみます。
 
kEnt167_1  kEnt167_3  kEnt167_31

「Sheet1」に元のデータがあったとして、「Sheet3」に結果を・・・・
これを考えた時、
・1つの関数にして、
・グループ化する部分を可変にしておけば・・・・

という事で、
Private Sub ListMake1(sSrc As String, sDest As String, Optional iCols As Long = 2)
意味的には
Private Sub ListMake1(データのあるシート名, 結果出力シート名, グループ化する列数)
として、A列から何列をグループ化して・・・・
重複を排除して羅列する部分は、その右隣の列を・・・・
(列数=2 をデフォルトにして、列数=2 なら A,B列でグループ化して、C列を羅列化)

Public Sub Pat1()
  Call ListMake1("Sheet1", "Sheet3")
End Sub
と記述すれば、一応出来上がります。

という事で、関数として記述したのは以下
Private Sub ListMake1(sSrc As String, sDest As String, Optional iCols As Long = 2)
  Dim dic As Object, dicSub As Object
  Dim iRow As Long
  Dim i As Long
  Dim sS As String
  Dim v As Variant
  Const sDLM As String = "_★_"

  Set dic = CreateObject("Scripting.Dictionary")
  With Worksheets(sSrc)
    iRow = 2
    While (.Cells(iRow, 1) <> "")
      sS = ""
      For i = 1 To iCols
        sS = sS & sDLM & .Cells(iRow, i)
      Next
      sS = Mid(sS, Len(sDLM) + 1)
      If (dic.Exists(sS)) Then
        Set dicSub = dic.Item(sS)
      Else
        Set dicSub = CreateObject("Scripting.Dictionary")
        dic.Add sS, dicSub
      End If
      dicSub.Item(.Cells(iRow, iCols + 1).Value) = Null
      iRow = iRow + 1
    Wend
  End With

  If (dic.Count > 0) Then
    With Worksheets(sDest)
      .Cells.ClearContents
      iRow = 2
      For Each v In dic.Keys
        For i = 1 To iCols
          .Cells(iRow, i) = Split(v, sDLM)(i - 1)
        Next
        Set dicSub = dic.Item(v)
        .Cells(iRow, iCols + 1).Resize(, dicSub.Count) = dicSub.Keys
        iRow = iRow + 1
      Next
      For i = 1 To iCols
        .Cells(1, i) = Worksheets(sSrc).Cells(1, i)
      Next
      With Range(.Cells(1, iCols + 1), .Cells(1, .Cells(2, 1).CurrentRegion.Columns.Count))
        .Formula = "=""" & Worksheets(sSrc).Cells(1, iCols + 1) & """ & Column() - " & iCols
        .Value = .Value
      End With
    End With
  End If
End Sub

 
グループ化する列間に "_★_" の文字を入れて、1つの文字列にしてキーとして利用
そのキーが登録されていなかったら、Dictionary の値に Dictionary を登録しておいて、
「購入者」をキーとしてドンドン放り込む・・・・

グループ化したものが1件でもあったら、
・結果出力シートを綺麗にしてから、
・登録していたキーを "_★_" で分離したものを出力しておいて、
・「購入者」部分のキー群を出力
・見出し部分を元シートからコピーしておいて
・「購入者」を羅列する部分は、「購入者1」「購入者2」・・・のように数字をつけたいので、
 Formula を使って、="購入者" & Column()-2  を設定後、
 「式」ではなく「値」にしたいので .Value = .Value

また、以下の様なデータが「Sheet2」にあって
県名品物名種別購入者
青森りんご果物西田さん
青森りんご果物斉藤さん
青森りんご果物山田さん
愛媛キウイ果物島田さん
愛媛みかん果物石川さん
愛媛みかん果物佐藤さん
愛媛みかん果物田中さん
愛媛みかん果物小林さん
岩手うにうにアキちゃん
岩手うにうに夏さん
岩手うにうに春さん
岩手まめぶ汁物安部ちゃん

「Sheet4」に結果を出したかったら
県名品物名種別購入者1購入者2購入者3購入者4
青森りんご果物西田さん斉藤さん山田さん 
愛媛キウイ果物島田さん   
愛媛みかん果物石川さん佐藤さん田中さん小林さん
岩手うにうにアキちゃん夏さん春さん 
岩手まめぶ汁物安部ちゃん   

Public Sub Pat2()
  Call ListMake1("Sheet2", "Sheet4", 3)
End Sub
と、シート名、列数部分を変更して呼び出せばできますね。


これだけでは何なんで、関数内の記述の仕方を変更してみます。
・Dictionary の値を参照する時に、
 dic.Item(sS) という記述は、 dic(sS) と同じみたい。
・また、「購入者」を管理する際に、Set dicSub = dic.Item(sS) の様にしていましたが、
 変数 dicSub を使わないで・・・・
この2つを変更してみます。

Private Sub ListMake2(sSrc As String, sDest As String, Optional iCols As Long = 2)
  Dim dic As Object
  Dim iRow As Long
  Dim i As Long
  Dim sS As String
  Dim v As Variant
  Const sDLM As String = "_★_"

  Set dic = CreateObject("Scripting.Dictionary")
  With Worksheets(sSrc)
    iRow = 2
    While (.Cells(iRow, 1) <> "")
      sS = ""
      For i = 1 To iCols
        sS = sS & sDLM & .Cells(iRow, i)
      Next
      sS = Mid(sS, Len(sDLM) + 1)
      If (Not dic.Exists(sS)) Then
        dic.Add sS, CreateObject("Scripting.Dictionary")
      End If
      dic(sS)(.Cells(iRow, iCols + 1).Value) = Null
      iRow = iRow + 1
    Wend
  End With

  If (dic.Count > 0) Then
    With Worksheets(sDest)
      .Cells.ClearContents
      iRow = 2
      For Each v In dic.Keys
        For i = 1 To iCols
          .Cells(iRow, i) = Split(v, sDLM)(i - 1)
        Next
        .Cells(iRow, iCols + 1).Resize(, dic(v).Count) = dic(v).Keys
        iRow = iRow + 1
      Next
      For i = 1 To iCols
        .Cells(1, i) = Worksheets(sSrc).Cells(1, i)
      Next
      With Range(.Cells(1, iCols + 1), .Cells(1, .Cells(2, 1).CurrentRegion.Columns.Count))
        .Formula = "=""" & Worksheets(sSrc).Cells(1, iCols + 1) & """ & Column() - " & iCols
        .Value = .Value
      End With
    End With
  End If
End Sub

 
上記は、以下の記述で呼び出せます。
Public Sub Pat2()
  Call ListMake2("Sheet2", "Sheet4", 3)
End Sub


※ 記述の違いにより ListMake1 / ListMake2 どちらが速いのか・・・・わかりません
        For i = 1 To iCols
          .Cells(iRow, i) = Split(v, sDLM)(i - 1)
        Next
部分も、一度配列に展開してからやると、Split を呼ぶ回数が少なくなるから・・・
とか、Excel の表示更新を止めてから・・・・とか、変更するところは多々あると思います。
Split 部分が出てきたので、キーの文字列についてになりますが・・・・
キーを作るところでは、
      sS = ""
      For i = 1 To iCols
        sS = sS & sDLM & .Cells(iRow, i)
      Next
      sS = Mid(sS, Len(sDLM) + 1)
としていましたが、sS = Mid(sS, Len(sDLM) + 1) をしなくても良いですね。
( Where 条件 / Filter を作る時によくやる方法ですが・・・)
キー文字列先頭に "_★_" があろうが無かろうが、他に影響は無いですね・・・
キー文字列先頭に "_★_" を残したままなら、展開するところで
        For i = 1 To iCols
          .Cells(iRow, i) = Split(v, sDLM)(i)
        Next
に変更すれば・・・・(って、これは未検証)


※ Excel の関数を知っている方なら、違う方法でやられると思います。
  ( Dictionary を多段で・・・をやってみたかったので・・・・という事にしておいてください )

※ Dictionary の中に Dictionary ・・・・
 中に入れるもの・・・・ Collection / Recordset ・・・・ こういうものもできるんだろうか・・・
 使ってみたい場面が出てきたら、確認してみよう・・・・

 もし、Dictionary - Collection ができるのなら、
 Collection - Collection と、どの様な使い勝手の違いがあるのだろうか・・・・

 ま、それも、使ってみたい場面が出てきたら、確認してみよう・・・・


※ なお、元データに記述している「購入者」には重複がありません。
  出現順で重複排除・・・・と言っていたのに・・・・・
  適当にデータを変更して、確認してみてください。


サンプルは以下
 バージョン 2007
 ファイル kEnt167.zip
 サイズ 11,403
※ ファイルは zip 形式
※ 2007 で作成した Excel(xls) ファイル
※ 2000 / 2003 でも動作

関連記事

2013/08/17

Category: やってみる

TB: --  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。