ユーザーフォーム 3つのコンボボックスの連動について教えてください。

VBA初心者です。VBAでユーザーフォーム1を作成し、それぞれ「日報」というシートに張り付けることには成功しておりますが、「事業所名」を選択後、「管理番号」「施設名」のコンボボックスで検索、連動がうまくいきません。コンボボックス3「事業所名」で.AddItem "第1事業部".AddItem "第2事業部"他3事業所名と設定し、シート名「全施設」より、コンボボックス4「管理番号」(B2:B2000)で検索、同じくシート名「全施設」でコンボボックス5「施設名」(C2:Ｃ2000)を検索連動がうまくいきません。いろいろと検索して、設定しても思ったように出来ませんでした。アドバイスをよろしくお願い致します。

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

• 作成したユーザーフォームです。

  
    補足日時：2020/06/27 03:13

• 日報の画像です。

  
    補足日時：2020/06/27 03:14

No.3 ベストアンサー 回答者： tom04 回答日時： 2020/06/27 13:55

No.2です。

細かい検証をしていませんでした。
コンボボックス4のコードを変更してください。

Private Sub ComboBox4_Change()
　ComboBox5.Clear
　　Set myDic = CreateObject("Scripting.Dictionary")
　　　With Worksheets("全施設")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　myR = Range(.Cells(2, "A"), .Cells(lastRow, "C"))
　　　　　　For i = 1 To UBound(myR, 1)
　　　　　　　If myR(i, 1) = ComboBox3 And myR(i, 2) = ComboBox4 Then
　　　　　　　　myStr = ComboBox3 & "_" & ComboBox4 & "_" & myR(i, 3)
　　　　　　　　　If Not myDic.exists(myStr) Then
　　　　　　　　　　myDic.Add myStr, ""
　　　　　　　　　End If
　　　　　　　End If
　　　　　　Next i
　　　End With
　　　　myKey = myDic.keys
　　　　　For i = 0 To UBound(myKey)
　　　　　　myAry = Split(myKey(i), "_")
　　　　　　　ComboBox5.AddItem myAry(2)
　　　　　Next i
　　　　　　Set myDic = Nothing
End Sub

※　前回のコードでは不要なものまで表示されてしまいました。

※　前回書き忘れましたが、
コンボボックス3　→　コンボボックス4　→　コンボボックス5　の順での選択としています。

どうも失礼しました。m(_ _)m

この回答へのお礼

ありがとうございます！思い通りに出来ました‼初心者の私に優しく対応してくださり本当に感謝いたします。またわからないことがありましたら、お力添えをお願いしたく思います。重ねてお礼申し上げます。

お礼日時：2020/06/28 01:41

No.2 回答者： tom04 回答日時： 2020/06/27 12:53

こんにちは！

コンボボックス3～5だけの処理で良いのですね。
一例です。
尚、お示しの上側の画像のようにコンボボックス3～5に表示するデータは「全施設」シートのA～C列にあるものとします。

Dim myDic As Object
Dim i As Long, lastRow As Long
Dim myStr As String
Dim myKey, myItem, myR, myAry

Private Sub UserForm_Initialize()
　'//コンボボックス3～5以外の処理　←すでに出来ているものとする//

　'//▼ココから処理//
　ComboBox3.Clear
　ComboBox4.Clear
　ComboBox5.Clear
　　Set myDic = CreateObject("Scripting.Dictionary")
　　　With Worksheets("全施設")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　myR = Range(.Cells(2, "A"), .Cells(lastRow, "A"))
　　　　　　For i = 1 To UBound(myR, 1)
　　　　　　　If Not myDic.exists(myR(i, 1)) Then
　　　　　　　　myDic.Add myR(i, 1), ""
　　　　　　　End If
　　　　　　Next i
　　　End With
　　　　myKey = myDic.keys
　　　　　For i = 0 To UBound(myKey)
　　　　　　ComboBox3.AddItem myKey(i)
　　　　　Next i
　　　　　　Set myDic = Nothing
End Sub

Private Sub ComboBox3_Change()
　ComboBox4.Clear
　ComboBox5.Clear
　　Set myDic = CreateObject("Scripting.Dictionary")
　　　With Worksheets("全施設")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　myR = Range(.Cells(2, "A"), .Cells(lastRow, "B"))
　　　　　　For i = 1 To UBound(myR, 1)
　　　　　　　If myR(i, 1) = ComboBox3 Then
　　　　　　　　If Not myDic.exists(myR(i, 2)) Then
　　　　　　　　　myDic.Add myR(i, 2), ""
　　　　　　　　End If
　　　　　　　End If
　　　　　　Next i
　　　End With
　　　　myKey = myDic.keys
　　　　　For i = 0 To UBound(myKey)
　　　　　　ComboBox4.AddItem myKey(i)
　　　　　Next i
　　　　　　Set myDic = Nothing
End Sub

Private Sub ComboBox4_Change()
　ComboBox5.Clear
　　Set myDic = CreateObject("Scripting.Dictionary")
　　　With Worksheets("全施設")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　myR = Range(.Cells(2, "A"), .Cells(lastRow, "C"))
　　　　　　For i = 1 To UBound(myR, 1)
　　　　　　　myStr = myR(i, 1) & "_" & myR(i, 2) & "_" & myR(i, 3)
　　　　　　　　If Not myDic.exists(myStr) Then
　　　　　　　　　myDic.Add myStr, ""
　　　　　　　　End If
　　　　　　Next i
　　　End With
　　　　myKey = myDic.keys
　　　　　For i = 0 To UBound(myKey)
　　　　　　myAry = Split(myKey(i), "_")
　　　　　　　ComboBox5.AddItem myAry(2)
　　　　　Next i
　　　　　　Set myDic = Nothing
End Sub

こんな感じでどうなりますか？m(_ _)m

No.1 回答者： めぐみん_ 回答日時： 2020/06/27 04:55

まぁ１５年位前からこのような質問はあって解説サイトも増えてきてますが、もしまだご覧になってないなら一度試されては？

Excel VBA 複数(3つ以上)のコンボボックスに連動するリストを登録する
https://officedic.com/excel-vba-howto-combobox-3 …

この回答へのお礼

ご連絡ありがとうございます。お知らせくださいましたサイトは真っ先に見たのですが、自分で作成したテキスト1からコンボボックス2迄のコードにプラスしてどうしたら続けられるのか、初心者には考えが至らず皆様のお力添えにすがってしまいました。いきなり皆様にお伺いするのは失礼と思い、上記サイトの他もさんざん見て、試してみてやっぱりうまくいかず、最後の最後にお願いに参りました。自力で何とかしようとした事だけはご理解ください。また困ったことがありましたら、ご教示くださいますようお願い致します。

お礼日時：2020/06/28 01:50