[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コンボボックスの連携と複数シートからの参照』（T_T）
はじめまして。 見よう見まねでマクロを使用しております。
同一ユーザーフォーム上にコンボボックス１～９があり、 シート「①」には Ａ Ｂ Ｃ Ｄ Ｅ Ｆ ・・・ 都道府県 市区町村 会社名 業種 資本金 設立年月 ←１・２行目は項目行です 東京都 千代田区 Ａ社 化学品製造 １千万 大阪府 北区 Ｃ社 貿易商社 ２億 東京都 荒川区 Ｂ社 通信 １億 東京都 千代田区 Ｄ社 加工業 １千万 ・ ・
シート「②」には Ａ Ｂ Ｃ Ｄ Ｅ Ｆ ・・・ 都道府県 市区町村 会社名 部署名 担当者名 携帯番号 ←１・２行目は項目行です 東京都 千代田区 Ａ社 営業部 あ氏 ＊＊＊ 東京都 荒川区 Ｂ社 製造部 い氏 ▼▼▼ 東京都 荒川区 Ｂ社 営業部 う氏 ○○○ 大阪府 北区 Ｃ社 購買部 え氏 ××× ・ ・ というリストがあります。
コンボボックス１に「①」シートのA列を選択肢として表示し コンボボックス１の選択肢によってコンボボックス２に「①」シートのB列を表示 コンボボックス２の選択肢によってコンボボックス３に「①」シートのＣ列を表示 コンボボックス３の選択肢によってコンボボックス４に「①」シートのＤ列を表示
というように連携させたグループ１のコンボボックス郡があります。そして、
コンボボックス５に「②」シートのA列を選択肢として表示 （東京都 コンボボックス５の選択肢によってコンボボックス６に「②」シートのB列を表示 コンボボックス６の選択肢によってコンボボックス７に「②」シートのＣ列を表示 コンボボックス７の選択肢によってコンボボックス８に「②」シートのＤ列を表示 コンボボックス８の選択肢によってコンボボックス９に「②」シートのＥ列を表示 ＊＊＊以下は質問には直接関係ないかと思いますが、コードに影響するかもしれない！？ので・・・ コンボボックス９の選択肢によってラベル１に「②」シートのＦ列を表示 コンボボックス９の選択肢によってラベル２に「②」シートのＧ列を表示 コンボボックス９の選択肢によってラベル３に「②」シートのＨ列を表示 コンボボックス９の選択肢によってラベル４に「②」シートのＩ列を表示 コンボボックス９の選択肢によってラベル５に「②」シートのＪ列を表示 コンボボックス９の選択肢によってラベル６に「②」シートのＫ列を表示 ＊＊＊＊＊＊
というように連携させたグループ２のコンボボックス郡があります。 いずれのコンボボックスも重複は削除してリストを表示し、フォームを開いたときには何も選択されていない状態で表示されます。
これを、シート「①」のＡ列～Ｃ列とシート「②」のＡ列～Ｃ列は同じ内容なので、コンボボックス４～６を省きたいと思っています。 つまり、 コンボボックス１に「①」シートのA列を選択肢として表示し コンボボックス１の選択肢によってコンボボックス２に「①」シートのB列を表示 コンボボックス２の選択肢によってコンボボックス３に「①」シートのＣ列を表示 コンボボックス３の選択肢によってコンボボックス４に「①」シートのＤ列を表示 ＊ここまでは同じ コンボボックス３の選択肢によってコンボボックス５に「②」シートのＤ列を表示 ＊シート「②」のＡ～Ｃ列の絞込みは、コンボボックス１～３のシート「①」のＡ～Ｃ列絞込みで行われたことにする コンボボックス５の選択肢によってコンボボックス６に「②」シートのＥ列を表示 ＊＊＊以下は質問には直接関係ないかと思いますが、コードに影響するかもしれない！？ので・・・ コンボボックス６の選択肢によってラベル１に「②」シートのＦ列を表示 コンボボックス６の選択肢によってラベル２に「②」シートのＧ列を表示 コンボボックス６の選択肢によってラベル３に「②」シートのＨ列を表示 コンボボックス６の選択肢によってラベル４に「②」シートのＩ列を表示 コンボボックス６の選択肢によってラベル５に「②」シートのＪ列を表示 コンボボックス６の選択肢によってラベル６に「②」シートのＫ列を表示 ＊＊＊＊＊＊
要するに「都道府県・市区町村・会社名」の絞込みを１度ですませたいのです（シートを１つにまとめることは難しいです）。 こういったことは可能なのでしょうか？ ご教授宜しくお願い致します。
なんだかよく分かりませんが コードもどうなっているのかよく分かりませんし。。。 でも、ご説明だけを見ると
＞ コンボボックス７の選択肢によってコンボボックス８に「②」シートのＤ列を表示 いま、「②」シートのＤ列を表示する為のコードを実行するきっかけが コンボボックス７の選択 に成っている様ですが それを コンボボックス３の選択で行えば良いのではないでしょうか。。。？
コンボボックス６・７に表示する為のコードから順番に必要なら 表示以外の部分（絞り込みの部分）だけを コンボボックス２・３の選択で行うように変更する。
・・・全然外してたら済みません。
(HANA)
今現在はどのようにコードを組まれていますか？ 重複を絞っていると言う事はDictionaryオブジェクトを使っているのでしょうかね？
DictionaryであればKeyに対するItemをコンボボックスによって シート１の内容にしたりシート２の内容にしたり切り替えれば出来そうですね。
（ｍｏｍｏ）
わかりにくい質問で申し訳ありません。 現在のコードはだいたいこんな感じです。 （ＰＣの不具合でファイルが開けなくなってしまいました。 以下のコードは少し前のもので、この後多少手直ししてあります。 質問しておきながら曖昧で大変申し訳ありません。 過去ログ[[20090924220534]]『同一フォーム上に２組の連携するコンボボックスを作成』（ＳＪＣ）を ほとんどそのまま参考にさせて頂いています）
(T_T)
'＊Microsoft Scripting Runtime への参照設定要 [ツール] → [参照設定] →[Microsoft Scripting Runtime] チェック ボックスをオンにする
Option Explicit Private dic() As Scripting.Dictionary '第1グループ用 Private dicMax As Long '第1グループ用 Private Const BOXCOUNT1 = 4 '第1グループ用 Private dib() As Scripting.Dictionary '第2グループ用 Private dibMax As Long '第2グループ用 Private Const BOXCOUNT2 = 5 '第2グループ用
Private Sub ComboBox_Update(ByVal Combo1 As MSForms.ComboBox, _
ByVal Combo2 As MSForms.ComboBox, _
dictio() As Dictionary)
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 dictio(n).Keys
.AddItem v
.List(i, 1) = dictio(n).Item(v)
i = i + 1
Next
End With
End Sub
Private Sub UserForm_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(, BOXCOUNT1).Value
End With
dicMax = UBound(v) * BOXCOUNT1 '程度
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 BOXCOUNT1 - 1
If Not IsEmpty(v(i, colm)) Then sKey = v(i, colm)
If Not dic(n).Exists(sKey) Then
k = k + 1
dic(n)(sKey) = k
Set dic(k) = New Scripting.Dictionary
n = k
Else
n = dic(n)(sKey)
End If
Next
dic(n).Item(v(i, colm)) = Empty
Next
dicMax = k
With ComboBox1
.List = Application.Transpose(Array(dic(1).Keys, dic(1).Items))
End With
With Worksheets("②")
v = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)). _
Resize(, 11).Value 'K列まで
End With
dibMax = UBound(v) * BOXCOUNT2 '程度
ReDim dib(1 To dibMax)
Set dib(1) = New Scripting.Dictionary
k = 1
For i = 1 To UBound(v)
n = 1
For colm = 1 To BOXCOUNT2 - 1
If Not IsEmpty(v(i, colm)) Then sKey = v(i, colm)
If Not dib(n).Exists(sKey) Then
k = k + 1
dib(n)(sKey) = k
Set dib(k) = New Scripting.Dictionary
n = k
Else
n = dib(n)(sKey)
End If
Next
dib(n).Item(v(i, colm)) = v(i, 8) & vbTab & v(i, 5) & vbTab & v(i, 6)
Next
dibMax = k
With ComboBox5
.List = Application.Transpose(Array(dib(1).Keys, dib(1).Items))
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
For i = dibMax To 1 Step -1
Set dib(i) = Nothing
Next
End Sub
Private Sub ComboBox1_Change()
ComboBox_Update ComboBox1, ComboBox2, dic()
End Sub
Private Sub ComboBox2_Change()
ComboBox_Update ComboBox2, ComboBox3, dic()
End Sub
Private Sub ComboBox3_Change()
ComboBox_Update ComboBox3, ComboBox4, dic()
End Sub
Private Sub ComboBox5_Change()
ComboBox_Update ComboBox5, ComboBox6, dib()
End Sub
Private Sub ComboBox6_Change()
ComboBox_Update ComboBox6, ComboBox7, dib()
End Sub
Private Sub ComboBox7_Change()
ComboBox_Update ComboBox7, ComboBox8, dib()
End Sub
Private Sub ComboBox8_Change()
ComboBox_Update ComboBox8, ComboBox9, dib()
End Sub
細かくは見ていませんが、参考にしてここまで作れるのであれば、逆転の発想で 最初のリストが１つになっていれば作れるんじゃないかな？ と思うので
例えば
Dim v(), buf, i As Long, j As Long
With Worksheets("Sheet1")
buf = .Range("A2").CurrentRegion.Columns("A:D").Value
End With
v = buf
ReDim Preserve v(1 To UBound(buf), 1 To UBound(buf, 2) + 8)
With Worksheets("Sheet2")
buf = .Range("A2").CurrentRegion.Columns("D:K").Value
End With
For i = 1 To UBound(buf)
For j = 1 To UBound(buf, 2)
v(i, j + 4) = buf(i, j)
Next j
Next i
Erase buf
こんな感じでSheet1とSheet2のリストをくっつけた配列を作っておけば 複雑な事を回避して１組のDictionaryの制御で出来るのではないでしょうか？
丸付き数字はNetでは使えないのでSheet1、Sheet2と表記していますので変更してみてください。
（ｍｏｍｏ）
（momo）様 アドバイス有り難う御座います。 Sheet1とSheet2のリストをくっつけたリストを作ったことにして動かす・・・ ということでよいのでしょうか？（不勉強で申し訳ありません） 以前のコードも、過去ログの意味は理解できないままに 雰囲気でいじってみたら とりあえず上手く動いたので良しとした・・・というのが実際の所でして・・・。
教えて頂いたサンプルを拝見しつつ、またもや雰囲気でいじってみたのですが やはりちゃんと理解していないのでうまくいきません。
コンボボックス１にＳｈｅｅｔ１のＡ列３行目以下を重複削除で表示したいのですが Ｓｈｅｅｔ２のＡ列項目名（＝Ａ１）、Ｄ列項目名（Ｄ１）、Ａ列（＝Ａ３以下、重複削除）が表示されます。 このＡ列（＝Ａ３以下、重複削除）だけ表示させたいのですが）・・・。 コンボボックス１の表示リストがうまくいかないので、以下のコンボボックスも当然うまくいきません。
本当に申し訳ありませんがご指導頂ければ幸いです。
(T_T)
＞丸付き数字はNetでは使えないのでSheet1、Sheet2と表記しています・・・ 失礼致しました。 以下のコードsheet1、sheet2に修正致しました。
‘＊Microsoft Scripting Runtime への参照設定要 [ツール] → [参照設定] →[Microsoft Scripting Runtime] チェック ボックスをオンにする
‘＜前提＞ Option Explicit Private dic() As Scripting.Dictionary Private dicMax As Long Private Const BOXCOUNT1 = 6 ◆ComboBoxの数
Private Sub ComboBox_Update(ByVal Combo1 As MSForms.ComboBox, _
ByVal Combo2 As MSForms.ComboBox, _
dictio() As Dictionary) '第3引数に 使用dictionaryオブジェクト名を入れる
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 dictio(n).Keys
.AddItem v
.List(i, 1) = dictio(n).Item(v)
i = i + 1
Next
End With
End Sub
Private Sub UserForm_Initialize()
Dim sKey As String
Dim colm As Long, k As Long, n As Long
Dim v(), buf, i As Long, j As Long
With Worksheets("sheet1")
buf = .Range("A3").CurrentRegion.Columns("A:D").Value
End With
v = buf
ReDim Preserve v(1 To UBound(buf), 1 To UBound(buf, 2) + 8)
With Worksheets("sheet2")
buf = .Range("A3").CurrentRegion.Columns("D:K").Value
End With
For i = 1 To UBound(buf)
For j = 1 To UBound(buf, 2)
v(i, j + 4) = buf(i, j)
Next j
Next i
Erase buf
dicMax = UBound(v) * BOXCOUNT1 '程度
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 BOXCOUNT1 - 1
If Not IsEmpty(v(i, colm)) Then sKey = v(i, colm)
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, colm)) = v(i, 6) & vbTab & v(i, 7) & vbTab & v(i, 8) & vbTab & v(i, 9) & vbTab & v(i, 10) & vbTab & v(i, 11)
'---- 最後のComboBox6には F～K列の値を連動させる
Next
dicMax = k
With ComboBox1 '先頭レベルComboBox1の リストをセットする
.List = Application.Transpose(Array(dic(1).Keys, dic(1).Items))
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, dic()
End Sub
Private Sub ComboBox2_Change()
ComboBox_Update ComboBox2, ComboBox3, dic()
End Sub
Private Sub ComboBox3_Change()
ComboBox_Update ComboBox3, ComboBox4, dic()
End Sub
Private Sub ComboBox5_Change()
ComboBox_Update ComboBox5, ComboBox6, dic()
End Sub
Private Sub ComboBox6_Change()
Dim ss As String
Dim idx As Long
Dim v As Variant
With ComboBox6
idx = .ListIndex
If idx < 0 Then Exit Sub
v = Split(.List(idx, 1), vbTab) 'TABで結合された文字列をわける
label1.caption = v(0)
Label2.caption = v(1)
Label3.caption = v(2)
Label4.caption = v(3)
Label5.caption = v(4)
Label6.caption = v(5)
End With
End Sub
＊ＰＣ復活しました。 現在のコードは以下の通りです。
‘＊Microsoft Scripting Runtime への参照設定要 [ツール] → [参照設定] →[Microsoft Scripting Runtime] チェック ボックスをオンにする
‘＜前提＞ Option Explicit Private dic() As Scripting.Dictionary 'sheet1用 Private dicMax As Long 'sheet1用 Private Const BOXCOUNT1 = 4 ‘sheet1用 ◆ComboBoxの数 Private dib() As Scripting.Dictionary 'sheet2用 Private dibMax As Long 'sheet2用 Private Const BOXCOUNT2 =5 'sheet2用 ◆ComboBoxの数
Private Sub ComboBox_Update(ByVal Combo1 As MSForms.ComboBox, _
ByVal Combo2 As MSForms.ComboBox, _
dictio() As Dictionary) '第3引数に 使用dictionaryオブジェクト名を入れる
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 dictio(n).Keys
.AddItem v
.List(i, 1) = dictio(n).Item(v)
i = i + 1
Next
End With
End Sub
‘＜sheet1を参照するコンボボックス＞
Private Sub UserForm_Initialize()
Dim v, sKey As String
Dim i As Long, colm As Long, k As Long, n As Long
With Worksheets("sheet1") '------- sheet1のTree 作成
v = .Range("A3", .Cells(.Rows.Count, 1).End(xlUp)). _
Resize(, BOXCOUNT1).Value
End With
dicMax = UBound(v) * BOXCOUNT1 '程度
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 BOXCOUNT1 - 1
If Not IsEmpty(v(i, colm)) Then sKey = v(i, colm)
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, colm)) = Empty
Next
dicMax = k
With ComboBox1 '先頭レベルComboBox1の リストをセットする
.List = Application.Transpose(Array(dic(1).Keys, dic(1).Items))
End With
‘＜Sheet2を参照するコンボボックス＞
With Worksheets("sheet2") ' ------- sheet2のTree 作成
v = .Range("A3", .Cells(.Rows.Count, 1).End(xlUp)). _
Resize(, 11).Value 'K列まで
End With
dibMax = UBound(v) * BOXCOUNT2 '程度
ReDim dib(1 To dibMax)
Set dib(1) = New Scripting.Dictionary
k = 1
For i = 1 To UBound(v)
n = 1
For colm = 1 To BOXCOUNT2 - 1
If Not IsEmpty(v(i, colm)) Then sKey = v(i, colm)
If Not dib(n).Exists(sKey) Then
k = k + 1
dib(n)(sKey) = k '★下位のComboBox用dic番号
Set dib(k) = New Scripting.Dictionary
n = k
Else
n = dib(n)(sKey)
End If
Next
dib(n).Item(v(i, colm)) = v(i, 6) & vbTab & v(i, 7) & vbTab & v(i, 8) & vbTab & v(i, 9) & vbTab & v(i, 10) & vbTab & v(i, 11)
'---- 最後のComboBox9には K列の値を連動させる
Next
dibMax = k
With ComboBox5 '先頭のComboBox5 に リスト dib(1) をセット
.List = Application.Transpose(Array(dib(1).Keys, dib(1).Items))
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
For i = dibMax To 1 Step -1
Set dib(i) = Nothing
Next
End Sub
‘＜Sheet1を参照するコンボボックス＞
Private Sub ComboBox1_Change()
ComboBox_Update ComboBox1, ComboBox2, dic() '第3引数に 使用dictionaryオブジェクト名を入れる
End Sub
Private Sub ComboBox2_Change()
ComboBox_Update ComboBox2, ComboBox3, dic()
End Sub
Private Sub ComboBox3_Change()
ComboBox_Update ComboBox3, ComboBox4, dic()
End Sub
‘＜Sheet2を参照するコンボボックス＞
Private Sub ComboBox5_Change()
ComboBox_Update ComboBox5, ComboBox6, dib() '第3引数に 使用dictionaryオブジェクト名を入れる
End Sub
Private Sub ComboBox6_Change()
ComboBox_Update ComboBox6, ComboBox7, dib()
End Sub
Private Sub ComboBox7_Change()
ComboBox_Update ComboBox7, ComboBox8, dib()
End Sub
Private Sub ComboBox8_Change()
ComboBox_Update ComboBox8, ComboBox9, dib()
End Sub
Private Sub ComboBox9_Change()
Dim ss As String
Dim idx As Long
Dim v As Variant
With ComboBox9
idx = .ListIndex
If idx < 0 Then Exit Sub
v = Split(.List(idx, 1), vbTab) 'TABで結合された文字列をわける
label1.caption = v(0)
Label2.caption = v(1)
Label3.caption = v(2)
Label4.caption = v(3)
Label5.caption = v(4)
Label6.caption = v(5)
End With
End Sub
今更気づきましたがSheet1とSheet2はA～C列の行方向並びが同じではないんですね・・・ 行が違うだけで、必ず同じものが同じ行数だけあるんでしょうか？
同じなら、同じ並び順にすれば簡単なのですが（まぁこれはソートを掛ければ簡単ですが） 同じデータが無い場合はどう連携させていくのでしょう？
同じじゃないとすると・・・少しロジックに行き詰りました。（頭が回ってません＞＜） （ｍｏｍｏ）
一応動きました。。。
'------
Private dic As Object
Private Const BoxCount1 = 4 '第1グループ用
Private Const BoxCount2 = 5 '第2グループ用
Private Const BoxCom = 3 '共通個数
'======
'======
Private Sub UserForm_Initialize()
Dim tbl1 As Variant, tbl2 As Variant
Dim i As Long, ii As Long
Dim ky As String, kyi As Long
Dim itm As String, itmi As Long
Dim sdic As Object, sky As String
Set dic = CreateObject("scripting.dictionary")
Set sdic = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
tbl1 = .Range("A1").Resize(.Range("A" & Rows.Count).End(xlUp).Row, BoxCount1).Value
End With
With Sheets("Sheet2")
tbl2 = .Range("A1").Resize(.Range("A" & Rows.Count).End(xlUp).Row, 11).Value
End With
For i = 0 To BoxCount1 - 1
For ii = 3 To UBound(tbl1, 1)
If i = 0 Then
ky = "_T"
Else
ky = ""
For kyi = 1 To i
ky = ky & "_" & tbl1(ii, kyi)
Next
If i = BoxCom Then
ky = ky & "_G"
End If
End If
sky = ky & "_" & tbl1(ii, i + 1)
If Not dic.exists(ky) Then
dic(ky) = tbl1(ii, i + 1)
Else
If Not sdic.exists(sky) Then
dic(ky) = dic(ky) & "_" & tbl1(ii, i + 1)
End If
End If
sdic(sky) = Empty
Next
Next
For i = 0 To BoxCount2
For ii = 3 To UBound(tbl2, 1)
If i = 0 Then
ky = "_T"
Else
ky = ""
For kyi = 1 To i
ky = ky & "_" & tbl2(ii, kyi)
Next
If i = BoxCom Then
ky = ky & "_B"
End If
End If
If i < BoxCount2 Then
sky = ky & "_" & tbl2(ii, i + 1)
If Not dic.exists(ky) Then
dic(ky) = tbl2(ii, i + 1)
Else
If Not sdic.exists(sky) Then
dic(ky) = dic(ky) & "_" & tbl2(ii, i + 1)
End If
End If
sdic(sky) = Empty
Else
itm = ""
For itmi = 1 To 6
itm = itm & "_" & tbl2(ii, itmi + 5)
Next
dic(ky) = itm
End If
Next
Next
With ComboBox1
Label_Clear
ComboBox_Update "_T", ComboBox1
End With
Set sdic = Nothing
End Sub
'======
'======
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set dic = Nothing
End Sub
'======
'======
Private Sub ComboBox_Update(ByVal stkm As String, ByVal Combo2 As MSForms.ComboBox)
If Not dic.exists(stkm) Then Exit Sub
With Combo2
.List = Split(dic(stkm), "_")
If .ListCount = 1 Then
.ListIndex = 0
End If
End With
End Sub
'======
'======
Private Sub ComboBox_Clear(ByVal bxi As String)
Dim num As Variant
For Each num In Split(bxi, " ")
Controls("ComboBox" & num).Clear
Next
End Sub
'======
Private Sub Label_Clear()
Dim i As Long
For i = 1 To 6
Controls("Label" & i).Caption = ""
Next
End Sub
'======
'======
Private Function ky_made(ByVal bxi As String)
Dim num As Variant
For Each num In Split(bxi, " ")
ky_made = ky_made & "_" & Controls("ComboBox" & num).Text
Next
End Function
'======
'======
Private Sub ComboBox1_Change()
ComboBox_Clear "2 3 4 5 6"
Label_Clear
ComboBox_Update ky_made("1"), ComboBox2
End Sub
'======
Private Sub ComboBox2_Change()
ComboBox_Clear "3 4 5 6"
Label_Clear
ComboBox_Update ky_made("1 2"), ComboBox3
End Sub
'======
Private Sub ComboBox3_Change()
ComboBox_Clear "4 5 6"
Label_Clear
ComboBox_Update ky_made("1 2 3") & "_G", ComboBox4
ComboBox_Update ky_made("1 2 3") & "_B", ComboBox5
End Sub
'======
Private Sub ComboBox5_Change()
ComboBox_Clear "6"
Label_Clear
ComboBox_Update ky_made("1 2 3 5"), ComboBox6
End Sub
'======
Private Sub ComboBox6_Change()
Dim i As Long
Dim ky As String
Dim y As Variant
ky = ky_made("1 2 3 5 6")
If Not dic.exists(ky) Then
Label_Clear
Exit Sub
End If
y = Split(dic(ky), "_")
For i = 1 To 6
Controls("Label" & i).Caption = y(i)
Next
End Sub
'------
(HANA) 早速間違えてたので修正しました。2010/04/11 0:35
もう少し（笑）修正しました。 2010/04/12 13:55
(HANA)様 有り難う御座います。
Sheet3にコマンドボタン２があり、それを押すとユーザーフォーム２が開き、 そのユーザーフォーム２に質問させて頂いたコードを含むマクロを書いています。
早速教えて頂いたコードを試してみようとしたところ、Sheet3に書いてある
'---------------------------------- Private Sub CommandButton2_Click() UserForm2.Show End Sub '----------------------------------
が、「アプリケーション定義又はオブジェクト定義のエラーです」となってしまいます・・・。 原因が分かれば教えて頂けますか？ 不勉強で申し訳ありません。宜しくお願い致します。
(T_T)
念のためにお伺いしてみますが。。。。
Private Sub UserForm_Initialize() ↓ Private Sub UserForm2_Initialize()
なんてやってませんよね？
あとは。。。そのメッセージが出てデバッグボタンを押すと [UserForm2.Show]が黄色く成りますか？ その後、[F8]キーを押して一行ずつコードを実行させてみて下さい。
それから、最初に書いておきますが ユーザーフォームはあまり分からないので 変なことをするかもしれません。 その時は、許して下さい。
(HANA)
>Private Sub UserForm2_Initialize() なんてやってませんよね？ →はい。やっていないはずです。 （「Private Sub UserForm2_Initialize()」はNGってことで大丈夫ですよね・・・？）
＞[F8]キーを押して一行ずつコードを実行させてみて下さい →[UserForm2.Show]が黄色くなったまま動きません・・・。
＞ユーザーフォームはあまり分からないので変なことをするかもしれません。 →こちらこそ何もわからずわがままばかりで・・・。 丁寧に教えて頂き感謝しています。 ありがとうございます。
きっと他の部分で組んだコードで何かおかしなことをしてしまっているのでしょうね。 少しやり直してみたいと思います。 アドバイスを色々と本当にありがとうございます。
(T_T)
＞（「Private Sub UserForm2_Initialize()」はNGってことで大丈夫ですよね・・・？） はい、変更したらNGって事です。 UserFormの名前が変わったからと その部分まで変更して仕舞う方が過去に幾人か居られまして。。。
取り敢えず、 UserForm2.Show を実行するのではなく VBEの方から[ F5 ]で実行してみて貰うとどうでしょう？
＞少しやり直してみたいと思います。 でしたら、新しいブックを用意して ご提示のデータを使って（１・２行目が見出し。データは３行目から。 シート名は Sheet1,Sheet2） Sheet2はK列までデータを用意して貰って
ユーザーフォームに コンボボックス１～６ リスト１～６を作成し、コードを貼り付け。 [F5]で実行
してみてもらえると良いのですが。
(HANA)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.