[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『3つ以上のコンボボックス連携について』(Voume11）
はじめまして。
お世話になります。
VBAを1日前ぐらいにはじめた超初心者です。
色々と模索してたのですが、
コンボボックスのAddItemのmag2Combo2.xls例を用いて、
A列、B列、C列の内容というように、
3つ以上のコンボボックス連携を行いたいと思っています。
しかし、なかなか上手くいきません・・・。
コードは以下の通りです。（列3つを想定した時）
Option Explicit
Dim Level1(1000) As String, Level1C As Long
Dim sh3 As New Sheet3
' −−−−− −−−−− −−−−− −−−−− −−−−− −−−−−
' コンボボックス２つの連携例
'
' ユーザーフォームの構成は下の通り
'
' UserForm1
' ComboBox1
' ComboBox2
' ComboBox3
'
' コンボボックスに登録するデータはSheet3 の1列 と2列 と3列にある
' −−−−− −−−−− −−−−− −−−−− −−−−− −−−−−
Private Sub ComboBox1_Change()
' ComboBox1 が変更されたときの処理
Dim j As Long, r As Long, rmx As Long
With UserForm1
.ComboBox2.Text = "" ' 前回選択されていた内容をクリア
.ComboBox2.Clear ' ComboBox2 に登録されている項目を全て削除する
rmx = UFRowcount()
For r = 2 To rmx
If sh3.Cells(r, 1) = "" Then
Exit For
End If
If sh3.Cells(r, 1) = .ComboBox1.Text Then
' 1列目がComboBox1 と等しい行の2列目をComboBox2 に登録する
.ComboBox2.AddItem sh3.Cells(r, 2)
End If
Next r
End With
End Sub
Private Sub ComboBox2_Change()
' ComboBox2 が変更されたときの処理
Dim j As Long, r As Long, rmx As Long
With UserForm1
.ComboBox3.Text = "" ' 前回選択されていた内容をクリア
.ComboBox3.Clear ' ComboBox3 に登録されている項目を全て削除する
rmx = UFRowcount()
For r = 2 To rmx
If sh3.Cells(r, 2) = "" Then
Exit For
End If
If sh3.Cells(r, 2) = .ComboBox2.Text Then
' 2列目がComboBox2 と等しい行の3列目をComboBox3 に登録する
.ComboBox3.AddItem sh3.Cells(r, 3)
End If
Next r
End With
End Sub
Private Sub UserForm_Initialize()
' UserForm1 初期化時の処理
Dim r As Long, rmx As Long
Level1C = 0
rmx = UFRowcount()
For r = 2 To rmx
If sh3.Cells(r, 1) = "" Then
Exit For
End If
If UFSearchLevel1(sh3.Cells(r, 1)) = 0 Then
' 1列目の項目で登録されていないものをComboBox1 に登録する
UserForm1.ComboBox1.AddItem sh3.Cells(r, 1)
End If
Next r
End Sub
Function UFSearchLevel1(key) As Integer
' 項目がすでに登録されていないか調べて、登録されていなかったら登録する
' UFSearchLevel1 = 0 なら登録されていない、UFSearchLevel1 = 1なら登録されている
Dim i As Long
UFSearchLevel1 = 0
For i = 0 To Level1C
If Level1(i) = key Then
UFSearchLevel1 = 1
Exit Function
End If
Next i
Level1(Level1C) = key
Level1C = Level1C + 1
End Function
Function UFRowcount() As Long
' データ（行）がどこまであるか調べる
UFRowcount = sh3.Range("a65536").End(xlUp).Row + 1
End Function
単純にSUBプロシージャーをコピーして、
列の情報だけ変えれば出来ると思ったのですが、
上手く表現することはできますでしょうか？
御教示いただけると幸甚です。
よろしくお願いいたします。
＞なかなか上手くいきません・・・。 どの部分がどのように上手く行かないのでしょうか。 気が付いた限りでは、ComboBox2_Changeで、以下の部分。 If sh3.Cells(r, 2) = .ComboBox2.Text Then ComboBox3へのAddItemで、想定していないデータも登録されていってしまう可能性。 ComboBox1_Change で「sh3.Cells(r, 1) = .ComboBox1.Text」に当てはまらないものも 「sh3.Cells(r, 2) = .ComboBox2.Text」が当てはまってしまえば コンボボックスのリストに追加されてしまいますよね。 (みやほりん)(-_∂)b
Volume11です。 返信誠に有難う御座います。
ご説明不足で申し訳ありませんでした。
今のコードでマクロを実行すると、 A列内の重複している項目を省いた状態で ComboBox１に表示されますが、B列、C列と連携はするものの、 重複したものでもB列、C列に記入されているもの全てが表示され、 ComboBox１同様に表示できません。
表現したいことは、A列から重複しているものを省いた状態でComboBox1に表示し、 その中の複数ある項目から一つ選ぶと、選んだA列内の項目と同じ行にあるB列の項目を、 ComboBox1同様、ComboBox2に重複したものを省いた状態で表示させ、 ComboBox3もそれに倣いといったように表現させたいと思っております。
＜例＞
ワークシート内
A列 B列 C列 D列 果物 長野産 梨 100円 果物 長野産 りんご 50円 果物 青森産 りんご 150円 野菜 中国産 にんじん 30円 野菜 アメリカ産 とうもろこし 20円
コンボボックス表示
ComboBox1 果物を選択 ComboBox2 長野産を選択 ComboBox3 りんご選択 50円とポップアップにて表示 果物 ⇒ 長野産 ⇒ 梨 ⇒ 野菜 中国産 りんご
という様に表現させたいと思っております。
御教示いただけると幸甚です。
よろしくお願いいたします。
例として、投稿されたシートデータには、1行目が項目名であるという前提でよいですね？
Sheet3には、
A列 B列 C列 D列 種別 産地 産物 単価 果物 長野産 梨 100円 果物 長野産 りんご 50円 果物 青森産 りんご 150円 野菜 中国産 にんじん 30円 野菜 アメリカ産 とうもろこし 20円
上記の項目名は、私が適当に命名しました。 コードを見ると1行目が項目名として設定されているように思えます。 だとしたら、例として投稿されたデータにも項目名を提示してください。
もし、項目名がないデータなら、1行目には、項目名を付けてください。
Excelでデータベース的なことを行う場合、項目名があった方が機能を使う上で便利ですから・・・。
当該ユーザーフォームのモジュールに
'====================================================================================
Option Explicit
Private sht3rng As Range
Private Sub ComboBox1_Change()
Dim tmprng As Range
Dim crng As Range, rng As Range
Dim myvalue As Variant
ComboBox2.Clear
If sht3rng.Row > 1 Then
myvalue = ComboBox1.Text
Set tmprng = sht3rng.Columns("j:j")
Set rng = myspecialcells(tmprng.Offset(-1, 0).Resize(tmprng.Rows.Count + 1), _
tmprng, _
"=if(and(a2=""" & myvalue & """,countif(b$2:b2,b2)=1),1,"""")")
If Not rng Is Nothing Then
With ComboBox2
For Each crng In rng.Offset(0, -8)
.AddItem crng.Value
Next
End With
End If
End If
End Sub
'====================================================================================
Private Sub ComboBox2_Change()
Dim tmprng As Range
Dim crng As Range, rng As Range
Dim myvalue1 As Variant
Dim myvalue2 As Variant
ComboBox3.Clear
If sht3rng.Row > 1 Then
myvalue1 = ComboBox1.Text
myvalue2 = ComboBox2.Text
Set tmprng = sht3rng.Columns("j:j")
Set rng = myspecialcells(tmprng.Offset(-1, 0).Resize(tmprng.Rows.Count + 1), _
tmprng, _
"=if(and(a2=""" & myvalue1 & """,b2=""" & myvalue2 & """),1,"""")")
If Not rng Is Nothing Then
With ComboBox3
For Each crng In rng.Offset(0, -7)
.AddItem crng.Value
.List(.ListCount - 1, 1) = crng.Row
Next
End With
End If
End If
End Sub
'====================================================================================
Private Sub ComboBox3_Change()
With ComboBox3
.Visible = False
DoEvents
.Visible = True
If .ListIndex >= 0 Then
msgbox "種別 " & ComboBox1.Text & vbCrLf & _
"産地 " & ComboBox2.Text & vbCrLf & _
"産物 " & .Text & " " & Worksheets("sheet3").Cells(.List(.ListIndex, 1), 4).Value
End If
End With
End Sub
'====================================================================================
Private Sub UserForm_Initialize()
Dim tmprng As Range
Dim crng As Range, rng As Range
With Worksheets("sheet3")
Set sht3rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
End With
If sht3rng.Row > 1 Then
Set tmprng = sht3rng.Columns("j:j")
Set rng = myspecialcells(tmprng.Offset(-1, 0).Resize(tmprng.Rows.Count + 1), _
tmprng, _
"=if(countif(a$2:a2,a2)=1,1,"""")")
With ComboBox1
For Each crng In rng.Offset(0, -9)
.AddItem crng.Value
Next
End With
End If
End Sub
'====================================================================================
Function myspecialcells(ByVal rng1 As Range, ByVal rng2 As Range, ByVal fml As String) As Range
On Error Resume Next
rng2.Formula = fml
Set myspecialcells = Nothing
Set myspecialcells = rng1.SpecialCells(xlCellTypeFormulas, xlNumbers)
rng2.Formula = ""
On Error GoTo 0
End Function
これで試してみてください。 尚、データのあるシートSheet3のＪ列を作業列として、プログラムが使っています。
ichinose
本件、御教示いただきまして誠に有難う御座います。 非常に助かりました！ これからコードひとつひとつじっくり勉強させていただきます。
(Volume11)
Volume11です。 また御質問があります。 上のプログラムでコンボボックスをさらに増やして行きたい場合 （増やしたコンボボックスに関しては前回同様、重複削除） どのコードを変更、または加えればいいのでしょうか？ 下記のようなリストがあるとした場合、
Trade Item Type Size Vender Price Electrical Conduit EMT 1-1/2'' GreybaR 5.5 Electrical Conduit EMT 1'' GreybaR 40 Electrical Cable Flexible 1'' GreybaR 8 Electrical Conduit RMT 1/2'' GreybaR 30 Electrical Cable Shielded 3/4'' GreybaR 15 Electrical Tray Tee 9'' GreybaR 3 Electrical Conduit RMT 1'' GreybaR 4 Electrical Cable Flexible 1'' Rexel 100 Electrical Conduit RMT 1'' Rexel 10 Electrical Cable Shielded 1'' Rexel 20 Electrical Cable Tee 36'' Rexel 15 Millwright Anchor Chemical 45mm Depot 20 Millwright Anchor Chemical 35mm Depot 40 Millwright Anchor Normal 10mm Depot 0.5 Millwright Measure Self-Ret 5.5m Home 10 Millwright Anchor Chemical 35mm Khama 40 Millwright Anchor Chemical 50mm Lows 0.7 Millwright Anchor Normal 12mm Lows 0.5 Millwright Anchor Chemical 35mm Lows 50 Pipefitter Pipe PVC 1/2'' Lows 4 Pipefitter Hose Air 3/4'' THose 100 Pipefitter Pipe GalSteel 1/2'' THose 3 Pipefitter Pipe Steam 3'' THose 10
コンボボックス５つを使い連携させたいと思っております。 いずれは5つ目のコンボボックスの値が変わったら、Private Sub ComboBox5_Change()内のコードを変更し、 テキストボックス１に値段を表示させるようにする予定です。 下記のコードをいじくっているのですが、ComboBox5にたどり着く前に、うまく表示されるものと、されないもので別れます・・・。原因が分かりません。 コードは下記の通りです。
'====================================================================================
Option Explicit
Private sht3rng As Range
Private Sub ComboBox1_Change()
Dim tmprng As Range
Dim crng As Range, rng As Range
Dim myvalue As Variant
ComboBox2.Clear
If sht3rng.Row > 1 Then
myvalue = ComboBox1.Text
Set tmprng = sht3rng.Columns("j:j")
Set rng = myspecialcells(tmprng.Offset(-1, 0).Resize(tmprng.Rows.Count + 1), _
tmprng, _
"=if(and(a2=""" & myvalue & """,countif(b$2:b2,b2)=1),1,"""")")
If Not rng Is Nothing Then
With ComboBox2
For Each crng In rng.Offset(0, -8)
.AddItem crng.Value
Next
End With
End If
End If
End Sub
'====================================================================================
Private Sub ComboBox2_Change()
Dim tmprng As Range
Dim crng As Range, rng As Range
Dim myvalue1 As Variant
Dim myvalue2 As Variant
ComboBox3.Clear
If sht3rng.Row > 1 Then
myvalue1 = ComboBox1.Text
myvalue2 = ComboBox2.Text
Set tmprng = sht3rng.Columns("j:j")
Set rng = myspecialcells(tmprng.Offset(-1, 0).Resize(tmprng.Rows.Count + 1), _
tmprng, _
"=if(and(a2=""" & myvalue1 & """,b2=""" & myvalue2 & """,countif(c$2:c2,c2)=1),1,"""")")
If Not rng Is Nothing Then
With ComboBox3
For Each crng In rng.Offset(0, -7)
.AddItem crng.Value
.List(.ListCount - 1, 1) = crng.Row
Next
End With
End If
End If
End Sub
'====================================================================================
Private Sub ComboBox3_Change()
Dim tmprng As Range
Dim crng As Range, rng As Range
Dim myvalue1 As Variant
Dim myvalue2 As Variant
Dim myvalue3 As Variant
ComboBox4.Clear
If sht3rng.Row > 1 Then
myvalue1 = ComboBox1.Text
myvalue2 = ComboBox2.Text
myvalue3 = ComboBox3.Text
Set tmprng = sht3rng.Columns("j:j")
Set rng = myspecialcells(tmprng.Offset(-1, 0).Resize(tmprng.Rows.Count + 1), _
tmprng, _
"=if(and(a2=""" & myvalue1 & """,b2=""" & myvalue2 & """,c2=""" & myvalue3 & """,countif(d$2:d2,d2)=1),1,"""")")
If Not rng Is Nothing Then
With ComboBox4
For Each crng In rng.Offset(0, -6)
.AddItem crng.Value
.List(.ListCount - 1, 1) = crng.Row
Next
End With
End If
End If
End Sub
'====================================================================================
Private Sub ComboBox4_Change()
Dim tmprng As Range
Dim crng As Range, rng As Range
Dim myvalue1 As Variant
Dim myvalue2 As Variant
Dim myvalue3 As Variant
Dim myvalue4 As Variant
ComboBox5.Clear
If sht3rng.Row > 1 Then
myvalue1 = ComboBox1.Text
myvalue2 = ComboBox2.Text
myvalue3 = ComboBox3.Text
myvalue4 = ComboBox4.Text
Set tmprng = sht3rng.Columns("j:j")
Set rng = myspecialcells(tmprng.Offset(-1, 0).Resize(tmprng.Rows.Count + 1), _
tmprng, _
"=if(and(a2=""" & myvalue1 & """,b2=""" & myvalue2 & """,c2=""" & myvalue3 & """,d2=""" & myvalue4 & """,countif(e$2:e2,e2)=1),1,"""")")
If Not rng Is Nothing Then
With ComboBox5
For Each crng In rng.Offset(0, -5)
.AddItem crng.Value
.List(.ListCount - 1, 1) = crng.Row
Next
End With
End If
End If
End Sub
'====================================================================================
Private Sub ComboBox5_Change()
With ComboBox4
.Visible = False
DoEvents
.Visible = True
If .ListIndex >= 0 Then
MsgBox "Trade " & ComboBox1.Text & vbCrLf & _
"Item " & ComboBox2.Text & vbCrLf & _
"Type " & .Text & " " & Worksheets("sheet3").Cells(.List(.ListIndex, 1), 4).Value
End If
End With
End Sub
Private Sub CmbBtnClear_Click()
ComboBox1.Value = ""
ComboBox2.Value = ""
ComboBox3.Value = ""
ComboBox4.Value = ""
End Sub
Private Sub FormBtnClose_Click()
Unload Me
End Sub
Private Sub MultiPage1_Change()
End Sub
'====================================================================================
Private Sub UserForm_Initialize()
Dim tmprng As Range
Dim crng As Range, rng As Range
With Worksheets("sheet3")
Set sht3rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
End With
If sht3rng.Row > 1 Then
Set tmprng = sht3rng.Columns("j:j")
Set rng = myspecialcells(tmprng.Offset(-1, 0).Resize(tmprng.Rows.Count + 1), _
tmprng, _
"=if(countif(a$2:a2,a2)=1,1,"""")")
With ComboBox1
For Each crng In rng.Offset(0, -9)
.AddItem crng.Value
Next
End With
End If
End Sub
'====================================================================================
Function myspecialcells(ByVal rng1 As Range, ByVal rng2 As Range, ByVal fml As String) As Range
On Error Resume Next
rng2.Formula = fml
Set myspecialcells = Nothing
Set myspecialcells = rng1.SpecialCells(xlCellTypeFormulas, xlNumbers)
rng2.Formula = ""
On Error GoTo 0
End Function
どなたか御教示頂けないでしょうか？ よろしくお願い申し上げます。 (Volume11)
＞うまく表示されるものと、されないもので別れます・・・。 この時の「上手く表示されない物」として どの様な組み合わせで選ぶと上手く表示されないのか 書いてあると良いと思います。
こちらでその組み合わせを見つける必要が無くなりますので。
一つは見つけました。 再度ご提示のサンプルで以下の組み合わせの時、上手く表示されません。 Pipefitter - Hose - Air ・・・・
思いますに「COUNTIF」部分がおかしいと思います。 Houseは全体を通して１回しか出てきません。 Airも同様です。 その他の項目も、ここまでは それまでに選んできたグループの外に重複がない ですね。
ですから、 それまでの項目が一致して「a2=""" & myvalue1 & """,b2=""" & myvalue2 & """,・・・・」 次の項目の内上から確認し初めて出てくるもの「countif(c$2:c2,c2)=1)」 が次のコンボボックスに表示されれば良いですが D列の項目はそうはいきません。
Pipefitter - Hose - Air と選んだ時に、22行目の「3/4''」が 次のコンボボックスに表示されたいですが、D列だけをみると6行目に 一度「3/4''」が有るので、22行目のCOUNTIFの戻り値は「2」と成り この行が対象から外れてしまいます。
ですので、COUNTIF関数ではなくSUMPRODUCT関数で これまで選んできたグループの中で、初めて出てくる物は と言う形にするのが良いのではないかと思います。 SUMPRODUCT((a$2:a2=""" & myvalue1 & """)*(b$2:b2=""" & myvalue2 & """)*(c$2:c2=c2))=1 の様に。
それから、ComboBox5に表示させる内容を絞り込むときにも 重複を除いていますが ここは重複が有った場合は そのまま表示させるのが良いと思いますよ。
もしも重複が有った場合は、直す必要が有るのだと思いますので。
(HANA)
ごめんなさい。私のコードには、確かにバグがありそうです。先週から、ちょっと入院してまして、 昨日退院してきました。投稿後、気が付きましたが、もう遅かった・・・・。
Dictionaryオブジェクトを使ったほうがよかったかなあ。
一週間も経ってしまい、病み上がりなので、 申し訳ないですが、HANAさんよろしくお願いします。
ichinose
えぇっ、ichinoseさん 大丈夫ですか？ （病み上がりだから「！」が無いのかな？） これから寒さ本番ですからね。 お早い目で体調を戻して下さいね。 Volume11さんの為にも。。。。
(HANA)
返信が遅れまして申し訳ありません! 御教示いただきまして誠に有難う御座いました。 次回より質問の仕方についても気をつけてまいりたいと思います。
御丁寧な解説が分かりやすく、非常に勉強になりました！ また、もし不明なことが出てきた時には、 御教示いただけると幸甚です。 上記の方法でトライさせていただきます！
ichinose様
御体調の方は、大丈夫でしょうか！？！？ 病み上がりなのにも関わらず、本件に関してフォローしていただきまして、 本当に有難う御座います。 色々とお気遣いしていただき、申し訳ありません。 御無理はなされず、お体には御自愛ください。
(Volume11)
こんにちは。
ComboBoxの絞り込みというか 連動表示は興味深い問題で、 このスレッドが始まったときにはずっとROMさせていただいていました。
> Dictionaryオブジェクトを使ったほうがよかったかなあ。 Dictionary案でいくと、どのようになるのか、ちょっと試行錯誤してみました。
まず、簡単な例として ichinoseさんのサンプルデータのうち2列だけを取り出して、
A B
1 分類 産物
2 果物 梨
3 果物 りんご
4 果物 りんご
5 野菜 にんじん
6 野菜 とうもろこし
これを ComboBox1のListに
果物
野菜
とリストし、果物が選択されたら {梨, りんご} と、
野菜が選択されたら {にんじん、とうもろこし} と別のComboBoxに表示する
までを考えてみました。
一番最初に思いつく方法は、単純に
dictionaryをひとつ用意して
dic("果物") = dic("果物") & "," & "梨"
dic("果物") = dic("果物") & "," & "りんご"
...
とキー「果物」のアイテムに 産物（B列）を集合させていくことですが、この方法ですと
アイテム配列内の要素の重複チェックをしていませんので、結果は:
key Item
dic("果物") = {梨, りんご, りんご}
dic("野菜") = {にんじん, とうもろこし}
と、このばあい「りんご」が重複してリストされてしまいます。
そこで、Items配列も 別のDictionaryをあてがうことにより、Itemに重複がないような 方法を考えます。 ...と、言葉にすると、なんのことか分からないので、以下、図を交えながら、 考え方を紹介します。 先ほどのデータを上から順に 以下のような判定で複数の辞書に登録していきます。
1つ目のデータ： 分類「果物」 産物「梨」
-------- dic(1)に「果物」は登録されているか ？
まだなので dic(1)のkeyに「果物」を登録。
そして 分類「果物」用のSubItemを管理するdic(2)を作り、
ここに 産物「梨」を登録する。 （下図）
┃ ┃ ┃ ┃
┃果物(2) ┃ ┃梨 ┃
┗━━━━┛ ┗━━━━┛
dic(1) dic(2) ★ この時点で dic(1)のkey は「果物」があり、
そのItemには（梨という産物名ではなく）[2]という参照辞書番号が
エントリされている
2つめのデータ： 「果物」の「りんご」
----------- dic(1)に「果物」は登録されているか ？
すでにあるので dic(1)「果物」のSubItemを管理するdic番号 (2) に
りんご を登録する。
┃ ┃ ┃りんご ┃
┃果物(2) ┃ ┃梨 ┃
┗━━━━┛ ┗━━━━┛
dic(1) dic(2)
3つめのデータ :「果物」の「りんご」
------- dic(1)に「果物」は登録されているか ？
すでにあるので
dic(1)「果物」のSubItemを管理するdic番号 (2) に
りんご を登録する。
┃ ┃ ┃りんご ┃ ★このとき dic(2)にすでに「りんご」は登録されている
┃果物(2) ┃ ┃梨 ┃ ので、dic(2) のkeyは{梨、りんご} の２つのままである。
┗━━━━┛ ┗━━━━┛
dic(1) dic(2)
4つめのデータ ：「野菜」の「にんじん」
-------- dic(1)に「野菜」は登録されているか ？
まだなので dic(1)のkeyに「野菜」を登録。
同時に 「野菜」用のSubItemを管理するdic(3)を作る
dic(3)に「にんじん」を登録。
┃野菜(3) ┃ ┃りんご ┃ ┃ ┃
┃果物(2) ┃ ┃梨 ┃ ┃にんじん┃
┗━━━━┛ ┗━━━━┛ ┗━━━━┛
dic(1) dic(2) dic(3)
最後のデータ ---「野菜」の「とうもろこし」
----- dic(1)に「野菜」は登録されているか ？
すでにあるので
dic(1)「野菜」のSubItemを管理するdic番号 (3) に
とうもろこし を登録する。
┃野菜(3) ┃ ┃りんご ┃ ┃もろこし┃
┃果物(2) ┃ ┃梨 ┃ ┃にんじん┃
┗━━━━┛ ┗━━━━┛ ┗━━━━┛
dic(1) dic(2) dic(3)
５行を読み込んだ結果はこうなります：
dic(1)「果物」= dic(2) {梨, りんご }
dic(1)「野菜」= dic(3) {にんじん, とうもろこし }
こんどは りんごの重複が回避できました。
つづく (kanabun)
こんどは 先ほどのサンプルデータ表↓全体を
1 分類 産物 産地 単価 2 果物 梨 長野産 100 3 果物 りんご 長野産 130 4 果物 りんご 青森産 150 5 野菜 にんじん 中国産 20 6 野菜 とうもろこし アメリカ産 30
ComboBox1 →ComboBox2 →ComboBox3 と TextBoxに絞り込み連動表示させることを 考えてみます。
▼最初のデータ 分類「果物」 産物「梨」 産地「長野産」単価「100」
-------- dic(1)に「果物」は登録されているか ？
まだなので dic(1)のkeyに「果物」を登録。
同時に 「果物」用のSubItemを管理するdic(2)を作る。
産物「梨」用の 産地dic はまだ無いので dic(3)を追加し、
ここに「長野」100 を登録する
┃ ┃ ┃ ┃ ┃ ┃
┃果物(2) ┃ ┃梨(3) ┃ ┃長野(100) ┃
┗━━━━┛ ┗━━━━┛ ┗━━━━━━┛
dic(1) dic(2) dic(3)
▼2つ目のデータ
「果物」 「りんご」 「長野産」 「130」
----- dic(1)に「果物」はすでに登録済なので その産物用番号(2)を得る。
dic(2) に「りんご」を登録する。
「りんご」の産地番号は未登録なので あらたにdic(4)を作り、ここに「長野」を登録する。
┃ ┃ ┃りんご(4) ┃ ┃ ┃ ┃ ┃
┃果物(2) ┃ ┃梨(3) ┃ ┃長野(100) ┃ ┃長野(130) ┃
┗━━━━┛ ┗━━━━━┛ ┗━━━━━━┛ ┗━━━━━━┛
dic(1) dic(2) dic(3) dic(4)
▼3つ目のデータ
「果物」 「りんご」 「青森産」 「150」
----- dic(1)に「果物」はすでに登録済なので その産物用番号(2)を得る。
dic(2) に「りんご」を登録する（★すでに「りんご」はあるので上書きされる）。
「りんご」の産地番号は(4)なので dic(4)に「青森」を登録する。
┃ ┃ ┃りんご(4) ┃ ┃ ┃ ┃青森(150) ┃
┃果物(2) ┃ ┃梨(3) ┃ ┃長野(100) ┃ ┃長野(130) ┃
┗━━━━┛ ┗━━━━━┛ ┗━━━━━━┛ ┗━━━━━━┛
dic(1) dic(2) dic(3) dic(4)
▼4つ目のデータ 「野菜」 「にんじん」 「中国産」 「20」
-------- dic(1)に「野菜」は未登録なので
dic(1)のkeyに「野菜」を登録。野菜の産物用dic(5) を新たに作り、
ここに「にんじん」を登録。「にんじん」の産地用dic(6)を新たに作り
ここに 「中国(50)」を登録。
┃野菜(5) ┃ ┃りんご(4) ┃ ┃ ┃ ┃青森(150) ┃
┃果物(2) ┃ ┃梨(3) ┃ ┃長野(100) ┃ ┃長野(130) ┃
┗━━━━┛ ┗━━━━━┛ ┗━━━━━━┛ ┗━━━━━━┛
dic(1) dic(2) dic(3) dic(4)
┃ ┃ ┃ ┃
┃にんじん(6) ┃ ┃中国(50) ┃
┗━━━━━━┛ ┗━━━━━━┛
dic(5) dic(6)
▼最後のつ目のデータ目 「野菜」 「とうもろこし」 「アメリカ産」 「30」
------- dic(1)の「野菜」の産物用dic番号は(5)なので
「とうもろこし」をdic(5)に追加。
「とうもろこし」は初出なのでこれの「産地」用のdic(7)を作成。
dic(7)に アメリカ産 30 を登録。
┃野菜(5) ┃ ┃りんご(4) ┃ ┃ ┃ ┃青森(150) ┃
┃果物(2) ┃ ┃梨(3) ┃ ┃長野(100) ┃ ┃長野(130) ┃
┗━━━━┛ ┗━━━━━┛ ┗━━━━━━┛ ┗━━━━━━┛
dic(1) dic(2) dic(3) dic(4)
┃もろこし(7) ┃ ┃ ┃ ┃ ┃
┃にんじん(6) ┃ ┃中国(50) ┃ ┃アメリカ(30)┃
┗━━━━━━┛ ┗━━━━━━┛ ┗━━━━━━┛
dic(5) dic(6) dic(7)
UserFormの表示の流れですが
ComboBox1 には dic(1)の KeysとSubItems を 以下のようにリストしておく。
果物 2
野菜 5
(リストの2列目は非表示)
ComboBox1で_Click() があれば、選択リストの2列目の番号に対応する
dicを ComboBox2のリストに表示する。
(例えば、ComboBox1の「果物」が選択されたら、dic番号は(2)なので、
ComboBox2 には dic(2)を以下のように出力する。
梨 3
りんご 4
(リストの2列目は非表示)
ComboBox2 で りんご がクリックされたら、ComboBox3のリストを
dic(4)内容によって更新すればよい。
長野産 130
青森産 150
(リストの2列目は非表示)
ComboBox3 で 「青森産」が選択されたら、テキストボックスには ComboBox3のリストの2列目の値「150」を表示すればよい。
と、だいたいこんな流れです
つづく (kanabun)
上の考えに基づき (Volume11) さんの表データ Trade Item Type Size Vender Price Electrical Conduit EMT 1-1/2'' GreybaR 5.5 Electrical Conduit EMT 1'' GreybaR 40 Electrical Cable Flexible 1'' GreybaR 8 Electrical Conduit RMT 1/2'' GreybaR 30 Electrical Cable Shielded 3/4'' GreybaR 15 Electrical Tray Tee 9'' GreybaR 3 Electrical Conduit RMT 1'' GreybaR 4 Electrical Cable Flexible 1'' Rexel 100 Electrical Conduit RMT 1'' Rexel 10 Electrical Cable Shielded 1'' Rexel 20 Electrical Cable Tee 36'' Rexel 15 Millwright Anchor Chemical 45mm Depot 20 Millwright Anchor Chemical 35mm Depot 40 Millwright Anchor Normal 10mm Depot 0.5 Millwright Measure Self-Ret 5.5m Home 10 Millwright Anchor Chemical 35mm Khama 40 Millwright Anchor Chemical 50mm Lows 0.7 Millwright Anchor Normal 12mm Lows 0.5 Millwright Anchor Chemical 35mm Lows 50 Pipefitter Pipe PVC 1/2'' Lows 4 Pipefitter Hose Air 3/4'' THose 100 Pipefitter Pipe GalSteel 1/2'' THose 3 Pipefitter Pipe Steam 3'' THose 10
を対象にコード化するとこんな風です。 なお、
> コンボボックス５つを使い連携させたいと思っております。 ということですが、便宜上 ComboBoxは すべて ListBoxに代えてあります。
'◆Microsoft Scripting Runtime への参照設定が必要です '----------------------------------------------------------- Option Explicit
Private dic() As Scripting.Dictionary Private dicMax As Long Private Const ComboCount = 5 'ListBoxの数
Private Sub UserForm_Initialize()
Dim v, sKey As String
Dim i As Long, j As Long, k As Long, n As Long
With Worksheets("Sheet2") '◆ 対象シート 要変更
v = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)). _
Resize(, ComboCount + 1).Value
End With
dicMax = UBound(v) * 2 ' Dictionaryは いくつ要るか判らないので とりあえず レコード数＊２ 程度としています
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 ComboCount - 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 '★ItemにkeySting用dic番号
Set dic(k) = New Scripting.Dictionary
n = k
Else
n = dic(n)(sKey)
End If
Next
dic(n).Item(v(i, ComboCount)) = v(i, ComboCount + 1)
Next
dicMax = k
Debug.Print "dic.Count= "; k
With ListBox1
.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 ListBox1_Change()
ComboBox_Update ListBox1, ListBox2
End Sub
Private Sub ListBox2_Change()
ComboBox_Update ListBox2, ListBox3
End Sub
Private Sub ListBox3_Change()
ComboBox_Update ListBox3, ListBox4
End Sub
Private Sub ListBox4_Change()
ComboBox_Update ListBox4, ListBox5
End Sub
'-----------------------------------------------------------
' Private Sub ComboBox_Update(ByVal List1 As MSForms.ComboBox, _
ByVal List2 As MSForms.ComboBox) ComboBoxのときは 下を こちらに代えてください
Private Sub ComboBox_Update(ByVal List1 As MSForms.ListBox, _
ByVal List2 As MSForms.ListBox)
Dim idx As Long
Dim n As Long, i As Long
Dim v
idx = List1.ListIndex
If idx < 0 Then Exit Sub
n = List1.List(idx, 1)
With List2
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
'-----------------------------------------------------------
Private Sub ListBox5_Change()
Dim idx As Long
With ListBox5
idx = .ListIndex
If idx < 0 Then Exit Sub
TextBox1.Text = .List(idx, 1)
End With
End Sub
'---------------------- とりあえず今までのところこんなコードですが、 こうしたほうがよいとか ありましたら コメントください m(__)m
(kanabun) 2009-06-14 0:40頃
kanabun様
お返事が大変遅れまして申し訳ありません。 ご丁寧なご説明をしていただきまして、誠に有難うございます。 考え方のステップが非常に分かり易かったです。 Dictionaryの使い方が未だ勉強不足なので、 コードをじっくり消化させていただきたく思います。 ご教示有難うございました。
Volume11 2010-01-09 USA EST16:50頃
勉強中との事ですし、折角書いたので参考にアップしてみます。 ComboBoxを増やすのを簡単に書いてみました。
Private myComb As New Collection Private myRng As Range
Private Sub UserForm_Initialize()
Dim i As Long, tbl As Variant
For i = 1 To 5
myComb.Add Me.Controls("ComboBox" & i)
Next i
With Worksheets("Sheet1").Range("A1").CurrentRegion
Set myRng = .Offset(1).Resize(.Rows.Count - 1)
End With
With CreateObject("Scripting.Dictionary")
tbl = myRng.Resize(, 1).Value
For i = 1 To UBound(tbl)
If Not .Exists(tbl(i, 1)) Then
.Add tbl(i, 1), ""
End If
Next i
Me.ComboBox1.List = .keys
End With
End Sub
Private Sub ComboBox1_Change() SetList 1 End Sub
Private Sub ComboBox2_Change() SetList 2 End Sub
Private Sub ComboBox3_Change() SetList 3 End Sub
Private Sub ComboBox4_Change() SetList 4 End Sub
Private Sub ComboBox5_Change() SetList 5 '必要無いけど・・・ End Sub
Private Sub SetList(CntNum As Long)
Dim tbl1 As Variant, tbl2 As Variant, i As Long, myKey As String
If CntNum >= myComb.Count Then Exit Sub
For i = CntNum + 1 To myComb.Count
myComb(i).Clear
Next i
tbl1 = myRng.Resize(, CntNum).Value
tbl2 = myRng.Offset(, CntNum).Resize(, 1).Value
For i = 1 To CntNum
myKey = myKey & vbTab & myComb(i).Value
Next i
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tbl1)
If Join(Application.WorksheetFunction.Index(tbl1, i, 0), vbTab) = Mid(myKey, 2) Then
If Not .Exists(tbl2(i, 1)) Then
.Add tbl2(i, 1), ""
End If
End If
Next i
myComb(CntNum + 1).List = .keys
End With
End Sub
（ｍｏｍｏ）
ろくでなし業者のスパム広告が書き込まれていたので広告を削除
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.