VBA 多次元配列を用いてグループ分けしたい

こんばんは
以下のようにmyListの中に、「果物」、「県名」、「月名」にカテゴリー分類された配列があります。
そして、Recipe配列の中に記載してある、それぞれの要素がmyListのどのカテゴリーに分類されているかを検索し、最終的には、それぞれのカテゴリーに分類された中身を表示したいのです。

下記の例では、最終的にDebug.printにて
果物 = りんご、いちご、バナナ
県名 = 静岡
と表示したいのです。（該当するものがないカテゴリー（今回は月名）は表示しない）

Filter関数にて、要素がカテゴリーリストに存在するかどうかはできたのですが、最終的にカテゴライズして表示する方法がわかりませんでした。
すみませんが、教えていただけると幸いです。

Sub Test()
Dim myList , Recipe

myList = Array( _
Array("メロン", "りんご", "バナナ", "ナシ", "いちご"), _
Array("神奈川", "東京", "静岡", "千葉", "埼玉"), _
Array("1月", "2月", "3月", "4月", "5月") _
)

Recipe = Array("りんご", "静岡", "いちご","バナナ")

End Sub

質問者からの補足コメント

• Recipe配列の中に重複している要素がある場合もあります。
  
  例えば
  Recipe = Array("りんご", "静岡", "いちご","バナナ","静岡")
  のような場合です。
  
  この場合、重複していても表示はしたくて
  果物 = りんご、いちご、バナナ
  県名 = 静岡、静岡
  としたいのです。

    補足日時：2016/04/09 21:47

No.1 ベストアンサー 回答者： 30246kiku 回答日時： 2016/04/10 09:02

雰囲気以下でどうなりますか

提示あった myList 内容では、「果物」等との関連付けができてないので変更
Samp1 では、静岡、静岡
Samp2 では、静岡
なお、どちらともカテゴリを求める時には、「りんご」「リンゴ」は同じと解釈
Samp1 では、「りんご」「リンゴ」は別表示
Samp2 では、同じものとして先に出現した文字列で

結果は

果物 = りんご、いちご、バナナ、リンゴ
県名 = 静岡、静岡
果物 = りんご、いちご、バナナ
県名 = 静岡


Sub Test()
　　Dim myList, Recipe

　　myList = Array( _
　　　　Array("果物", Array("メロン", "りんご", "バナナ", "ナシ", "いちご")), _
　　　　Array("県名", Array("神奈川", "東京", "静岡", "千葉", "埼玉")), _
　　　　Array("月名", Array("1月", "2月", "3月", "4月", "5月")) _
　　)

　　Recipe = Array("りんご", "静岡", "いちご", "バナナ", "リンゴ", "静岡")

　　Call Samp1(myList, Recipe)
　　Call Samp2(myList, Recipe)
End Sub


Public Sub Samp1(myList As Variant, Recipe As Variant)
　　Dim dic As Object, dicL As Object
　　Dim vK As Variant, v As Variant
　　Dim i As Long

　　Set dic = CreateObject("Scripting.Dictionary")
　　Set dicL = CreateObject("Scripting.Dictionary")
　　dicL.CompareMode = vbTextCompare

　　For Each vK In myList
　　　　For Each v In vK(1)
　　　　　　dicL(v) = vK(0)
　　　　Next
　　Next

　　For Each v In Recipe
　　　　vK = dicL(v)
　　　　If (IsEmpty(vK)) Then vK = "他"
　　　　If (Not dic.Exists(vK)) Then
　　　　　　dic.Add vK, CreateObject("Scripting.Dictionary")
　　　　End If
　　　　i = dic(vK).Count
　　　　dic(vK)(i) = v
　　Next

　　For Each vK In dic.Keys
　　　　Debug.Print vK & " = " & Join(dic(vK).Items, "、")
　　Next

　　Set dic = Nothing
　　Set dicL = Nothing
End Sub


Public Sub Samp2(myList As Variant, Recipe As Variant)
　　Dim dic As Object, dicL As Object
　　Dim vK As Variant, v As Variant

　　Set dic = CreateObject("Scripting.Dictionary")
　　Set dicL = CreateObject("Scripting.Dictionary")
　　dicL.CompareMode = vbTextCompare

　　For Each vK In myList
　　　　For Each v In vK(1)
　　　　　　dicL(v) = vK(0)
　　　　Next
　　Next

　　For Each v In Recipe
　　　　vK = dicL(v)
　　　　If (IsEmpty(vK)) Then vK = "他"
　　　　If (Not dic.Exists(vK)) Then
　　　　　　dic.Add vK, CreateObject("Scripting.Dictionary")
　　　　　　dic(vK).CompareMode = vbTextCompare
　　　　End If
　　　　dic(vK)(v) = Empty
　　Next

　　For Each vK In dic.Keys
　　　　Debug.Print vK & " = " & Join(dic(vK).Keys, "、")
　　Next

　　Set dic = Nothing
　　Set dicL = Nothing
End Sub

この回答へのお礼

期待通りの動作です！
一部、理解しきれない部分もありますが、リファレンス読んでじっくり考えてみます

お礼日時：2016/04/12 21:55