ユーザーフォームに２つのコンボボックス銀行名「ConboBox1」支店名を「ConboBox2」とし

ユーザーフォームに２つのコンボボックス銀行名「ConboBox1」支店名を「ConboBox2」とし、
各コンボボックスへ銀行名、支店名を入力すると銀行コートを「TextBox１」へ支店コードを「TextBox２」へ
表示するため、下記コードで書いてみました。
しかし、２つのコンボボックスが連動していないため、複数銀行で同一支店名を入力すると図のように他銀行の支店コードを表示してしまします。
＊みずほ銀行の品川支店の支店コードは、「195」なのに、連動の仕方が解らず
りそな銀行、品川支店の支店コード「306」を表示してしまします。
お手数ですが連動させるにはどのような修正を加えたらよいかお知恵を貸していただけませんでしょか。
宜しくお願い致します。
Private Sub UserForm_Initialize()
With Worksheets("銀行別支店コード")
For i = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
ComboBox1.AddItem .Cells(i, 1).Value
ComboBox2.AddItem .Cells(i, 3).Value
Next
End With
End Sub
・・・・・
Private Sub ComboBox1_Change()
Dim r As Range
Set r = Worksheets("銀行別支店コード").Columns("A:A").Find _
(ComboBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
TextBox1.Value = r.Offset(0, 1).Value
Else
TextBox1.Value = ""
End If
End Sub
・・・・
Private Sub ComboBox2_Change()
Dim r As Range
Set r = Worksheets("銀行別支店コード").Columns("C:C").Find _
(ComboBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
TextBox2.Value = r.Offset(0, 1).Value
Else
TextBox2.Value = ""
End If
Private Sub UserForm_Initialize()
With Worksheets("銀行別支店コード")
For i = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
ComboBox1.AddItem .Cells(i, 1).Value
ComboBox2.AddItem .Cells(i, 3).Value
Next
End With
End Sub
・・・・・
Private Sub ComboBox1_Change()
Dim r As Range
Set r = Worksheets("銀行別支店コード").Columns("A:A").Find _
(ComboBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
TextBox1.Value = r.Offset(0, 1).Value
Else
TextBox1.Value = ""
End If
End Sub
・・・・
Private Sub ComboBox2_Change()
Dim r As Range
Set r = Worksheets("銀行別支店コード").Columns("C:C").Find _
(ComboBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
TextBox2.Value = r.Offset(0, 1).Value
Else
TextBox2.Value = ""
End If
End Sub

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

• ありがとうございます。
  
  素晴らしい、コンボボックス２に該当支店しか表示しないなんて夢のようです。
  
  あと１点だけ教えてください。
  
  コンボボックス１へプルダウンを選ばず（登録銀行が２４行と多いため）直接銀行名を入力しようとすると
  
  「ReDim arrList(dic.Count - 1, 1)」がエラーになります。
  回避することができますでしょうか？
  よろしくお願い致します。

    補足日時：2022/08/03 20:56

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2022/08/03 20:01

Private Sub UserForm_Initialize()

のようなコードで重複しない銀行名リストでComboBox1を設定して
ComboBox2には値を与えないようにします

ComboBox1のChangeで
TextBox1の値を代入（行われています）と同時に
選択している値を基にComboBox2を設定します
一例では､ComboBox1の設定する時に店舗名と支店番号を同時に取得する方法を取っています｡
ComboBox2ChangeでシンプルにTextBox2に値を代入する事が出来ます

処理の各箇所にはやり方が色々ありますが一例です

この回答へのお礼

ユーザーフォームの書き出しで追加のご相談
ユーザーフォームの値をシートに書き出す際、コードが表示される。
２つのコンボボックスを連動させるコードを教えていただき、その後、ユーザーフォームを書き出すコードを作成しました。
しかしコンボボックスに表示された値と連動させたテキストボックスの値が書き出されてしまいます。
追加の質問で恐縮ですがコード上どこを修正したら良いかご教示いただけませんでしょうか？
よろしくお願いいたします。
Private Sub CommandButton1_Click()
Dim i As Long
Dim lastRow As Long
With Worksheets("Sheet1")
lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
　　 .Cells(lastRow, 2).Value = ComboBox1
.Cells(lastRow, 3).Value = TextBox1.Text
.Cells(lastRow, 4).Value = ComboBox2
.Cells(lastRow, 5).Value = TextBox2.Text
End With
End Sub

お礼日時：2022/08/05 10:53

No.4 回答者： Qchan1962 回答日時： 2022/08/03 22:24

すみません、以前のご質問で回答させていただいた時の様に

1文字入力時に実行されないようにExitイベントを使う方が良かったかもしれません

Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

また、入力銀行名が見つからない場合、dic.Countは0でdic.Count-1としているのでエラー9が返るのだと思われます
従って、dicに登録できない事を想定して

End With
If dic.Count < 1 Then Exit Sub
ReDim arrList(dic.Count - 1, 1)
でいかがでしょうか

Exit Subだと何も起こらなかったようになってしまいますので
Msgboxなどで入力確認を促して、フォーカスを戻す等するのが良いかも知れません

入力自体をさせないようにするのは、面倒なようですので
選択のみ有効にするのはあまり良くないのかなと思いました
あまりにも選択種が多い場合、よくあるATMの様に頭文など文字入力ごとに
選択リストを絞って行く方法なども考えられますね

この場合は見やすさを考えるとチェックボックスやTextBoxとListBoxの連携になりますでしょうか・・

条件でリストを絞るやり方を覚えると色々出来そうですね
時間のある時に色々やってみてください

この回答へのお礼

昨夜は遅くまでありがとうございます。
完璧なご解答に感謝です。
私もQchan1962さんのような仕事ができるよう身を正します。素晴らしい！

お礼日時：2022/08/04 09:36

No.2 回答者： Qchan1962 回答日時： 2022/08/03 19:59

こんばんは

やぱりComboBoxですよね｡やり方は色々あります
現行だと同じ銀行名に複数支店があるとComboBox1に同じ銀行名が複数出来ると思います｡
文字数オーバーの為説明は再投稿します

Unique関数が使える環境でしたら
Private Sub UserForm_Initialize()
Dim 銀行List, i As Long
ComboBox2.Clear
With Worksheets("銀行別支店コード")
銀行List = WorksheetFunction.Unique(.Range("A4", .Cells(.Rows.Count, "A").End(xlUp)))
For i = 1 To UBound(銀行List)
ComboBox1.AddItem 銀行List(i, 1)
Next
End With
End Sub

Private Sub ComboBox1_Change()
Dim i As Long
Dim r As Range
Dim dic As Object
Dim 支店名, 支店番号
Dim arrList()

With Worksheets("銀行別支店コード")
'銀行コード
Set r = .Columns("A:A").Find _
(ComboBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
TextBox1.Value = r.Offset(0, 1).Value
Else
TextBox1.Value = ""
End If
'クリアー時の処理
Controls("ComboBox" & 2).Clear
If ComboBox1 = "" Then Exit Sub
'ComboBox2のデータ取得加工
Set dic = CreateObject("Scripting.Dictionary")
For i = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
If Not dic.Exists(.Cells(i, 3).Value) _
And ComboBox1.Value = .Cells(i, 1).Value Then
dic.Add .Cells(i, 3).Value, .Cells(i, 4).Value
End If
Next
End With

ReDim arrList(dic.Count - 1, 1)
支店名 = dic.Keys '念のため
支店番号 = dic.items
For i = 0 To dic.Count - 1
arrList(i, 0) = 支店名(i)
arrList(i, 1) = 支店番号(i)
Next
'ComboBox2の設定
With ComboBox2
.ColumnCount = 1 '表示列数
.TextColumn = 1 'Textで取得する列
.BoundColumn = 2 'Valueで取得する列
.List = arrList '参照List
End With
End Sub

Private Sub ComboBox2_Change()
'ComboBox2.Valueを設定（Textは支店名）
TextBox2.Value = ComboBox2.Value
End Sub

No.1 回答者： fujillin 回答日時： 2022/08/03 18:08

こんにちは

「銀行別支店コード」というシートの構成がわかりませんけれど、1行が
　A列　銀行名
　B列　銀行コード
　C列　支店名
　D列　支店コード
という構成で、全てのセルが埋められているとするなら・・

ComboBox2_Change で、単にC列だけを検索すると最初に見つかった支店名が一致する行を返しますので、ご質問のような状態になります。
支店名を探す時には、銀行名、支店名ともに一致する行を探す必要があるのではないでしょうか？

対策としては、
・現行の方法のままで行うなら、Findでヒットした際に、A列（銀行名）が一致しているかをチェックし、違っていたら次の支店名をFindで検索する。

あるいは、
・先に、銀行名でシートにフィルタをかけておいてから、Findを実行する。
（非表示の行はFindでヒットしませんので、現状のロジックでもそのまま使えると思います。）
（シートのフィルタの方法は、マクロの記録である程度分かると思います）


※ シートのレイアウトが違う場合は、上記の方法では求められない可能性がありますけれど・・