[[20090923194642]] 『コンボボックスの連携&重複削除』(SJC) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『コンボボックスの連携&重複削除』(SJC)

 はじめまして。
 マクロ使用およそ半年の初心者です。
 よろしくお願い致します。

 ユーザーフォーム上にコンボボックスが4つあり、
 別シート上に以下のようなリストがあります。

 「製品リスト」シート
    A     B     C        D
   分類    種目    名       受注単位    ←項目名行です
  披露宴    料理    オードブル    5
  二次会    料理    ポワソン     2
  式      料理    デザート     5
  披露宴    料理    ポワソン     5
  式      ギフト   宴後       2
  披露宴    ギフト   宴前       5
  二次会    引出物   先付       5
  披露宴    料理    オードブル    2

 コンボボックス1に「製品リスト」シートのA列を選択肢として(ただし重複を削除して)表示し、
 その選択肢によってコンボボックス2にB列を表示(重複削除)・・・と繰り返していきたいのです。

 コンボボックス1に「披露宴」「二次会」「式」を選択肢表示。
 「披露宴」を選択するとコンボボックス2に「料理」「ギフト」と表示
 「料理」を選択するとコンボボックス3に「オードブル」「ポワソン」と表示
 「オードブル」を選択するとコンボボックス4に「5」「2」と表示
 といった具合です。

 どうぞご教授よろしくお願い致します。

 こんばんは。
[[20081217082039]] 『3つ以上のコンボボックス連携について』(Voume11)
 をちょっとだけ修正したものですが、参考にしてください。

 '◆ Microsoft Scripting Runtime への参照設定が必要です

 Option Explicit

 Private dic() As Scripting.Dictionary
 Private dicMax As Long
 Private Const BOXCOUNT = 4  '◆ComboBoxの数

 Private Sub UserForm_Initialize()
    Dim v, sKey As String
    Dim i As Long, j As Long, k As Long, n As Long

    With Worksheets("製品リスト")
        v = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)). _
              Resize(, BOXCOUNT).Value
    End With

    dicMax = UBound(v) * BOXCOUNT '程度
    ReDim dic(1 To dicMax)
    Set dic(1) = New Scripting.Dictionary
    k = 1
    For i = 1 To UBound(v)
        n = 1
        For j = 1 To BOXCOUNT - 1
            If Not IsEmpty(v(i, j)) Then sKey = v(i, j)
            If Not dic(n).Exists(sKey) Then
                k = k + 1
                dic(n)(sKey) = k       '★下位のComboBox用dic番号
                Set dic(k) = New Scripting.Dictionary
                n = k
            Else
                n = dic(n)(sKey)
            End If
        Next
        dic(n).Item(v(i, j)) = Empty
    Next
    dicMax = k
    With ComboBox1
        .List = Application.Transpose(Array(dic(1).Keys, dic(1).Items))
        .ListIndex = 0
    End With
 End Sub

 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Dim i As Long
    For i = dicMax To 1 Step -1
        Set dic(i) = Nothing
    Next
 End Sub

 Private Sub ComboBox1_Change()
    ComboBox_Update ComboBox1, ComboBox2
 End Sub

 Private Sub ComboBox2_Change()
    ComboBox_Update ComboBox2, ComboBox3
 End Sub

 Private Sub ComboBox3_Change()
    ComboBox_Update ComboBox3, ComboBox4
 End Sub

 Private Sub ComboBox_Update(ByVal Combo1 As MSForms.ComboBox, _
                             ByVal Combo2 As MSForms.ComboBox)
    Dim idx As Long
    Dim n As Long, i As Long
    Dim v
    idx = Combo1.ListIndex
    If idx < 0 Then Exit Sub
    n = Combo1.List(idx, 1)
    With Combo2
        i = 0
        .Clear
        For Each v In dic(n).Keys
            .AddItem v
            .List(i, 1) = dic(n).Item(v)
            i = i + 1
        Next
        .ListIndex = 0
    End With

 End Sub

 どういうことをやっているかについては、
[[20081217082039]] 『3つ以上のコンボボックス連携について』(Voume11)
 を参照ください。

 (kanabun) 2009-09-23 21:20


 どうもありがとうございます。
 うまくいきました。内容については一つずつ勉強していきたいと思います。

 あつかましくも 追加で質問なのですが
 選択肢の表示順を降順(もしくは昇順 どちらでも)にすることはできますか?
 また、フォームを開いた時には何も選択されていない状態にすることは可能でしょうか? 

 どうぞ ご教授よろしくお願い致します。

 (SJC)

 こんにちは。

 > うまくいきました。内容については一つずつ勉強していきたいと思います。

 ▼リンク先の説明を読んでいただいても、よく分からないかも知れません。
   そこで、(ぼく自身の理解のためにも ^^)
   UserForm_Initialize() でやっているプロセスだけをイミディエイト・ウィンドウに
   図示するコードを書いてみました。
   以下のコードを「標準モジュール」にコピペして実行してみてください。
 '------------------------------------------------- 標準モジュール
 Option Explicit

 Private dic() As Scripting.Dictionary
 Private dicMax As Long
 Private Const FieldCOUNT = 4  '◆読み込む列の数

 Sub Debug_Initialize()
    Dim v, sKey As String
    Dim i As Long, colm As Long, k As Long, n As Long

    With Worksheets("製品リスト")
        v = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)). _
              Resize(, FieldCOUNT).Value
    End With

    dicMax = UBound(v) * FieldCOUNT '程度
    ReDim dic(1 To dicMax)
    Set dic(1) = New Scripting.Dictionary
    k = 1
    For i = 1 To UBound(v)
        n = 1
        For colm = 1 To FieldCOUNT
            sKey = v(i, colm)
            If colm = FieldCOUNT Then Exit For
            If Not dic(n).Exists(sKey) Then
                k = k + 1
                dic(n)(sKey) = k       '★下位のdic番号
                Debug.Print "dic["; n; "]"; sKey; k
                Set dic(k) = New Scripting.Dictionary
                n = k
            Else
                n = dic(n)(sKey)
            End If
        Next
        dic(n)(sKey) = Empty
        Debug.Print "dic["; n; "]"; sKey
        Debug.Print "------------------------↑ ここまで"; i; "行"
    Next
    dicMax = k

    ShowLevel 1, 1

    For i = dicMax To 1 Step -1
        Set dic(i) = Nothing
    Next

 End Sub

 Private Sub ShowLevel(ByVal n&, ByVal Level&)
  Dim ky, nSub&
  For Each ky In dic(n).Keys
      nSub = dic(n).Item(ky)
      Debug.Print String$((Level - 1) * 3, vbTab); "┗━"; ky;

      If nSub Then
          Debug.Print "("; CStr(nSub); ")"
          ShowLevel nSub, Level + 1
      Else
          Debug.Print
      End If
  Next

 End Sub
 '------------------------------------------------------ 標準モジュール コードここまで
 上を走らせると、イミディエイト・ウィンドウに次のような出力がされます。

 dic[ 1 ]披露宴 2 
 dic[ 2 ]料理 3 
 dic[ 3 ]ポワソン 4 
 dic[ 4 ]5
 ------------------------↑ ここまで 1 行
 dic[ 3 ]オードブル 5 
 dic[ 5 ]5
 ------------------------↑ ここまで 2 行
 dic[ 5 ]2
 ------------------------↑ ここまで 3 行
 dic[ 2 ]ギフト 6 
 dic[ 6 ]宴前 7 
 dic[ 7 ]5
 ------------------------↑ ここまで 4 行
 dic[ 1 ]二次会 8 
 dic[ 8 ]料理 9 
 dic[ 9 ]ポワソン 10 
 dic[ 10 ]2
 ------------------------↑ ここまで 5 行
 dic[ 8 ]引出物 11 
 dic[ 11 ]先付 12 
 dic[ 12 ]5
 ------------------------↑ ここまで 6 行
 dic[ 1 ]式 13 
 dic[ 13 ]料理 14 
 dic[ 14 ]デザート 15 
 dic[ 15 ]5
 ------------------------↑ ここまで 7 行
 dic[ 13 ]ギフト 16 
 dic[ 16 ]宴後 17 
 dic[ 17 ]2
 ------------------------↑ ここまで 8 行

 ┗━披露宴(2)
            ┗━料理(3)
                        ┗━ポワソン(4)
                                    ┗━5
                        ┗━オードブル(5)
                                    ┗━5
                                    ┗━2
            ┗━ギフト(6)
                        ┗━宴前(7)
                                    ┗━5
 ┗━二次会(8)
            ┗━料理(9)
                        ┗━ポワソン(10)
                                    ┗━2
            ┗━引出物(11)
                        ┗━先付(12)
                                    ┗━5
 ┗━式(13)
            ┗━料理(14)
                        ┗━デザート(15)
                                    ┗━5
            ┗━ギフト(16)
                        ┗━宴後(17)
                                    ┗━2
 手前みそですが、
 文章だけで理解するよりも、図示したほうがよく理解できるのではないでしょうか(^^

 > あつかましくも 追加で質問なのですが
 > 選択肢の表示順を降順(もしくは昇順 どちらでも)にすることはできますか?

 ▼簡単なのは 表をソートしておくことです。
   Key1:=分類列
   Key2:=種目
   Key3:=名
 の順で。

 > また、フォームを開いた時には何も選択されていない状態にすることは可能でしょうか? 

 ▼Private Sub UserForm_Initialize() と
 Private Sub ComboBox_Update() プロシージャ内にある
 >       .ListIndex = 0
 をコメントアウトしてみてください。

 (kanabun) 2009-09-24 10:35


 (kanabun)様 

 本当に丁寧に有り難う御座います!!
 実はまだ理解し切れていないところもあるのですが
 落ち着いてゆっくり見ていきたいと思います。

  > 選択肢の表示順を降順(もしくは昇順 どちらでも)にすることはできますか?
  ▼簡単なのは 表をソートしておくことです。
 →できました!! 有り難う御座います!!

 > また、フォームを開いた時には何も選択されていない状態にすることは可能でしょうか? 
  ▼〜をコメントアウトしてみてください。
 →こちらもできました。有り難う御座います!!!

 図に乗って 新たに質問です(新しく質問し直すべきなのかもしれませんが・・・)。
 同じユーザーフォーム上にテキストボックスがいくつか有り、
 テキストボックス1に入力したコードから別シート(「出荷関連情報」シート)をVlookupで検索し、
 結果をテキストボックス2以降に表示するコードを作りました。

 コードは以下の通りです。

 Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
 '=======================================================================================
 'TextBox1の出荷先CDから「出荷関連情報」シートをVlookupで検索して
 'TextBox2へ 出荷先名を表示
 'TextBox3へ 出荷先名を表示
 'TextBox12へ 試験表情報を表示
 'TextBox15へ 全品目共通 出荷時注意事項を表示
 'TextBox16へ 品目別 出荷時注意事項を表示
 '該当がない場合は「値が見つかりません」のエラー表示
 '=======================================================================================

   Dim 出荷先名 As String
   On Error Resume Next
   出荷先名 = WorksheetFunction.VLookup(Val(Me.TextBox1.Text), Sheets("出荷関連情報").Range("A1:H3500"), 2, False)
   事業所名1 = WorksheetFunction.VLookup(Val(Me.TextBox1.Text), Sheets("出荷関連情報").Range("A1:H3500"), 3, False)
   事業所名2 = WorksheetFunction.VLookup(Val(Me.TextBox1.Text), Sheets("出荷関連情報").Range("A1:H3500"), 4, False)
   試験表情報 = WorksheetFunction.VLookup(Val(Me.TextBox1.Text), Sheets("出荷関連情報").Range("A1:H3500"), 5, False)
   全品目共通出荷時注意事項 = WorksheetFunction.VLookup(Val(Me.TextBox1.Text), Sheets("出荷関連情報").Range("A1:H3500"), 6, False)
   品目別出荷時注意事項 = WorksheetFunction.VLookup(Val(Me.TextBox1.Text), Sheets("出荷関連情報").Range("A1:H3500"), 7, False)

   On Error GoTo 0
   If 出荷先名 <> "" Then
     Me.TextBox2.Text = 出荷先名
     Me.TextBox3.Text = 事業所名1
     Me.TextBox4.Text = 事業所名2
     Me.TextBox12.Text = 試験表情報
     Me.TextBox15.Text = 全品目共通出荷時注意事項
     Me.TextBox16.Text = 品目別出荷時注意事項

  Else
     MsgBox "CDの登録がありません"
   End If

 End Sub

 これだけ&質問させて頂いたコンボボックスの連携のコードだけならそれぞれきちんと動いたのですが
 両方のコードを書くと「コンパイルエラー 変数が定義されていません」と
 Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) が指定されてしまいます・・・。

 重ね重ねお手数ですが どうぞご教授宜しくお願い致します。

 (SJC)

 済みません。
 解決しました。
 お騒がせしました。

 (SJC)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.