[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コンボボックスの連携＆重複削除』（SJC）
はじめまして。 マクロ使用およそ半年の初心者です。 よろしくお願い致します。
ユーザーフォーム上にコンボボックスが４つあり、 別シート上に以下のようなリストがあります。
「製品リスト」シート A B C D 分類 種目 名 受注単位 ←項目名行です 披露宴 料理 オードブル ５ 二次会 料理 ポワソン ２ 式 料理 デザート ５ 披露宴 料理 ポワソン ５ 式 ギフト 宴後 ２ 披露宴 ギフト 宴前 ５ 二次会 引出物 先付 ５ 披露宴 料理 オードブル ２
コンボボックス１に「製品リスト」シートのA列を選択肢として（ただし重複を削除して）表示し、 その選択肢によってコンボボックス２にB列を表示（重複削除）・・・と繰り返していきたいのです。
コンボボックス１に「披露宴」「二次会」「式」を選択肢表示。 「披露宴」を選択するとコンボボックス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)様
本当に丁寧に有り難う御座います！！ 実はまだ理解し切れていないところもあるのですが 落ち着いてゆっくり見ていきたいと思います。
> 選択肢の表示順を降順（もしくは昇順 どちらでも）にすることはできますか？ ▼簡単なのは 表をソートしておくことです。 →できました！！ 有り難う御座います！！
> また、フォームを開いた時には何も選択されていない状態にすることは可能でしょうか？ ▼〜をコメントアウトしてみてください。 →こちらもできました。有り難う御座います！！！
図に乗って 新たに質問です（新しく質問し直すべきなのかもしれませんが・・・）。 同じユーザーフォーム上にテキストボックスがいくつか有り、 テキストボックス１に入力したコードから別シート（「出荷関連情報」シート）をVlookupで検索し、 結果をテキストボックス２以降に表示するコードを作りました。
コードは以下の通りです。
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) が指定されてしまいます・・・。
重ね重ねお手数ですが どうぞご教授宜しくお願い致します。
（ＳＪＣ）
済みません。 解決しました。 お騒がせしました。
（ＳＪＣ）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.