excelのコンボボックスでの階層リスト表示

質問

（すいません、再投稿します）
excelのコンボボックスで、階層にわけてリスト表示させたいのですが、うまくいきません。
数日悩んでまして、どなたか教えてもらえませんか。

シート１：会社名　　　　1列目：会社名　 2列目：ID
シート２：事業部名　　 1列目：事業部名　2列目：ID
シート３：部門名 　　　 1列目：部門名　 2列目：ID
シート４：担当名 　　　 1列目：担当名　 2列目：ID

ユーザーフォームにそれぞれのコンボボックスを作っています。
ComboBox1：会社名　　　　　TextBox1：ID
ComboBox2：事業部名　　　 TextBox2：ID
ComboBox3：部門名　　　　　TextBox3：ID
ComboBox4：担当名　　　　　TextBox4：ID

たとえば会社名がAのときは、ComboBox2ではAの事業部だけが表示される、というようなかんじです。
同時に隣のIDももってこないといけない為に、苦戦しています。助けてください。。。。
下記記述は3番、まではうまくいくのですが、”4番TextBox２の値代入”がうまくいきません。

--------

Option Explicit
Dim シート名 As String
Dim 行 As Long
Dim 範囲 As String
Dim 事業部範囲 As String

'-1---ComboBox1-------------------

Private Sub ComboBox1_DropButtonClick()
シート名 = "会社名"

Worksheets(シート名).Activate 'ワークシートをアクティブにする
Range("A1").CurrentRegion.Select 'アクティブセル領域を選択する
With Selection

行 = .Rows.Count '同上領域の行数を取得する
範囲 = .Cells(1, 1).Address & ":" & .Cells(行, 1).Address '同上領域のアドレスを変数に
End With
ComboBox1.RowSource = シート名 & "!" & 範囲 'コンボボックスのリストのソースを設定する
End Sub

'-2----ComboBox1-------------------
Private Sub ComboBox1_Click() 'コンボボックス上でクリックされると実行される
シート名 = "会社名"
行 = ComboBox1.ListIndex + 1 'コンボボックスで選択された行 + 1
TextBox1.Text = Worksheets(シート名).Cells(行, 2) '対応するセルの値をテキストボックスに
End Sub

'-3----ComboBox2-------------------

Private Sub ComboBox1_Change() ' ComboBox1 が変化した時の処理

シート名 = "事業部名"
Dim si As Integer
With UserForm1
.ComboBox2.Text = ""
si = .ComboBox1.ListIndex ' ComboBox1 の何番目が選択されたかを得る
Select Case si
Case 0 ' 0番が選択されていたらComboBox2 の内容
Worksheets(シート名).Activate
Range("A1:A6").CurrentRegion.Select
With Selection
事業部範囲 = .Cells(1, 1).Address & ":" & .Cells(6, 1).Address
End With
ComboBox2.RowSource = シート名 & "!" & 事業部範囲
Case 1
Worksheets(シート名).Activate
Range("A7:A11").CurrentRegion.Select
With Selection
事業部範囲 = .Cells(7, 1).Address & ":" & .Cells(11, 1).Address
End With
ComboBox2.RowSource = シート名 & "!" & 事業部範囲
Case 2
Worksheets(シート名).Activate
Range("A12:A15").CurrentRegion.Select
With Selection
事業部範囲 = .Cells(12, 1).Address & ":" & .Cells(15, 1).Address
End With
ComboBox2.RowSource = シート名 & "!" & 事業部範囲
Case 3
Worksheets(シート名).Activate
Range("A16:A25").CurrentRegion.Select
With Selection
事業部範囲 = .Cells(16, 1).Address & ":" & .Cells(25, 1).Address
End With
ComboBox2.RowSource = シート名 & "!" & 事業部範囲
End Select
End With
End Sub

'---4--TextBox2に値代入--------------------

Private Sub ComboBox2_Click()
Dim si As Integer
With UserForm1
.ComboBox2.Text = ""
si = .ComboBox2.ListIndex ' ComboBox2 の何番目が選択されたかを得る
Select Case si
Case 0 ' 0番が選択されていたらComboBox2 の内容 Range("A1:A6")
シート名 = "事業部名"
Worksheets(シート名).Activate
Range("A1:B6").CurrentRegion.Select
With Selection
事業部範囲 = .Cells(1, 2).Address & ":" & .Cells(6, 2).Address
End With
'行 = ComboBox2.ListIndex + 1
TextBox2.Text = Worksheets(シート名).Cells(事業部範囲, 2)
Case 1
Case 2
Case 3
End Select
End With
End Sub
'----5-Close--------------------
Private Sub UserForm_Deacti
Unload UserForm1
End Sub

回答No.2

watabe007 · ベストアンサー

With を使う必要は無いですね

>With Worksheets("会社名")
>　　Me.ComboBox1.RowSource = .Range("A1").CurrentRegion.Address(External:=True)
>End With
　　　↓
Me.ComboBox1.RowSource = Worksheets("会社名").Range("A1").CurrentRegion.Address(External:=True)

>With Worksheets("事業部名")
>　　Me.ComboBox2.RowSource = .Range(add事業部).Address(External:=True)
>End With
　　　↓
Me.ComboBox2.RowSource = Worksheets("事業部名").Range(add事業部).Address(External:=True)

お礼

ご回答ありがとうございました。
別の方法でいちからやり直すことにしていまったのですが、
今後参考にさせて頂きます。

回答No.1

watabe007

こんにちは、参考に

Option Explicit
'-1---ComboBox1-------------------
Private Sub ComboBox1_DropButtonClick()
　　With Worksheets("会社名")
　　　　Me.ComboBox1.RowSource = .Range("A1").CurrentRegion.Address(External:=True)
　　End With
End Sub
'-2----ComboBox1-------------------
Private Sub ComboBox1_Click()
　　Me.TextBox1.Text = Me.ComboBox1.Column(1)
End Sub
'-3----ComboBox2-------------------
Private Sub ComboBox1_Change()
　　Dim add事業部 As String

　　If Me.ComboBox1.ListIndex = -1 Then
　　　　Me.ComboBox2.RowSource = ""
　　　　Exit Sub
　　End If
　　Select Case Me.ComboBox1.ListIndex
　　　　Case 0: add事業部 = "A1:B6"
　　　　Case 1: add事業部 = "A7:B11"
　　　　Case 2: add事業部 = "A12:B15"
　　　　Case 3: add事業部 = "A16:B25"
　　End Select
　　With Worksheets("事業部名")
　　　　Me.ComboBox2.RowSource = .Range(add事業部).Address(External:=True)
　　End With
End Sub
'---4--TextBox2に値代入--------------------
Private Sub ComboBox2_Click()
　　Me.TextBox2.Text = Me.ComboBox2.Column(1)
End Sub

お礼

ご回答ありがとうございました。
別の方法でいちからやり直すことにしていまったのですが、
今後参考にさせて頂きます。