[[20131108095901]]　『comboboxをtextboxに変更』（KISS）　ページの最後に飛ぶ

『comboboxをtextboxに変更』（KISS）Ver2010　win7
いつも大変お世話になっております
皆様のお力で　ある程度形になってきたのですが
仕様変更のため　改造を掛けてるのですが
上手に出来ないため大変申し訳ございませんが
大変お手数と思いますが　ご教授をおねがいいたします

ユーザーフォームに　combobox１～９配置しておりますが
これをCombobox１～７にして　残りのcombobox８～９をtextbox１～２変更したいのですがどの様に改造すればよろしいのでしょうか

よろしくお願いいたします

 Option Explicit

 Private dic As Object

 Private Sub UserForm_Initialize()
     Dim a, i As Long, ii As Long
     Set dic = CreateObject("Scripting.Dictionary")
     dic.CompareMode = 1
     a = Sheets("sss").Cells(1).CurrentRegion.Resize(, 10).Value
     For i = 2 To UBound(a, 1)
         For ii = 1 To UBound(a, 2)
             a(i, ii) = CStr(a(i, ii))
         Next
         If Not dic.exists(a(i, 1)) Then
             Set dic(a(i, 1)) = CreateObject("Scripting.Dictionary")
             dic(a(i, 1)).CompareMode = 1
         End If
         If Not dic(a(i, 1)).exists(a(i, 2)) Then
             Set dic(a(i, 1))(a(i, 2)) = CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2)).exists(a(i, 3)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3)).exists(a(i, 4)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4)).exists(a(i, 5)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5)).exists(a(i, 6)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6)).exists(a(i, 7)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6))(a(i, 7)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6))(a(i, 7)).CompareMode = 1
         End If

     Next
     Me.ComboBox1.List = dic.keys
 End Sub

 Private Sub ComboBox1_Change()
     ClearComb 2, 9
     With Me
         If .ComboBox1.ListIndex <> -1 Then
             .ComboBox2.List = dic(.ComboBox1.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox2_Change()
     ClearComb 3, 9
     With Me
         If .ComboBox2.ListIndex <> -1 Then
             .ComboBox3.List = dic(.ComboBox1.Value)(.ComboBox2.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox3_Change()
     ClearComb 4, 9
     With Me
         If .ComboBox3.ListIndex <> -1 Then
             .ComboBox4.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox4_Change()
     ClearComb 5, 9
     With Me
         If .ComboBox4.ListIndex <> -1 Then
             .ComboBox5.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox5_Change()
     ClearComb 6, 9
     With Me
         If .ComboBox5.ListIndex <> -1 Then
             .ComboBox6.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value)(.ComboBox5.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox6_Change()
     ClearComb 7, 9
     With Me
         If .ComboBox6.ListIndex <> -1 Then
             .ComboBox7.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value)(.ComboBox5.Value)(.ComboBox6.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox7_Change()
     ClearComb 8, 9
     With Me
         If .ComboBox7.ListIndex <> -1 Then
             .ComboBox8.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value)(.ComboBox5.Value)(.ComboBox6.Value)(.ComboBox7.Value).keys
         End If
     End With
 End Sub

 Private Sub ClearComb(myStart, myEnd)
     Dim i As Long
     For i = myStart To myEnd
         Me.Controls("ComboBox" & i).Clear
     Next
 End Sub

 Private Sub CommandButton1_Click()
  Dim ctrl As Control, txt1 As String, txt2 As String
    Dim ret As Integer
    For Each ctrl In Me.Controls
        Select Case ctrl.Name
            Case "ComboBox1", "ComboBox2", "ComboBox3", "ComboBox4", "ComboBox5", "ComboBox6", "ComboBox7", "ComboBox8"
                If Len(Trim$(ctrl.Text)) = 0 Then
                    txt1 = txt1 & ctrl.Name & vbLf
                Else
                    txt2 = txt2 & ctrl.Text & vbLf
                End If
            Case Else
        End Select
    Next
    If Len(txt1) > 0 Then
        MsgBox "以下の値を入力してください" & vbLf & txt1, vbExclamation
        Exit Sub
    Else
        ret = MsgBox("以下の値を入力します" & vbLf & txt2, vbOKCancel)
        If ret <> vbOK Then Exit Sub
    End If
    With Worksheets("SSS").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 9)
        .Value = Array(ComboBox1.Value, ComboBox2.Value, ComboBox3.Value, ComboBox4.Value, _
                ComboBox5.Value, ComboBox6.Value, ComboBox7.Value, ComboBox8.Value, ComboBox9.Value)
        .Interior.ColorIndex = 3
    End With
    ClearComb 1, 9
    ThisWorkbook.Save
 End Sub

上記マクロを
下記のように書き換えまして
CommandButton1を押したとき
textboxがクリアー出来ません
たぶん基本的なことと思うのですが
function 当の設定方法がわからないためのと思っています

Option Explicit

 Private dic As Object

 Private Sub UserForm_Initialize()
     Dim a, i As Long, ii As Long
     Set dic = CreateObject("Scripting.Dictionary")
     dic.CompareMode = 1
     a = Sheets("sss").Cells(1).CurrentRegion.Resize(, 10).Value
     For i = 2 To UBound(a, 1)
         For ii = 1 To UBound(a, 2)
             a(i, ii) = CStr(a(i, ii))
         Next
         If Not dic.exists(a(i, 1)) Then
             Set dic(a(i, 1)) = CreateObject("Scripting.Dictionary")
             dic(a(i, 1)).CompareMode = 1
         End If
         If Not dic(a(i, 1)).exists(a(i, 2)) Then
             Set dic(a(i, 1))(a(i, 2)) = CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2)).exists(a(i, 3)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3)).exists(a(i, 4)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4)).exists(a(i, 5)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5)).exists(a(i, 6)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6)).exists(a(i, 7)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6))(a(i, 7)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6))(a(i, 7)).CompareMode = 1
         End If

     Next
     Me.ComboBox1.List = dic.keys
 End Sub

 Private Sub ComboBox1_Change()
     ClearComb 2, 7
     With Me
         If .ComboBox1.ListIndex <> -1 Then
             .ComboBox2.List = dic(.ComboBox1.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox2_Change()
     ClearComb 3, 7
     With Me
         If .ComboBox2.ListIndex <> -1 Then
             .ComboBox3.List = dic(.ComboBox1.Value)(.ComboBox2.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox3_Change()
     ClearComb 4, 7
     With Me
         If .ComboBox3.ListIndex <> -1 Then
             .ComboBox4.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox4_Change()
     ClearComb 5, 7
     With Me
         If .ComboBox4.ListIndex <> -1 Then
             .ComboBox5.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox5_Change()
     ClearComb 6, 7
     With Me
         If .ComboBox5.ListIndex <> -1 Then
             .ComboBox6.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value)(.ComboBox5.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox6_Change()
     ClearComb 7, 7
     With Me
         If .ComboBox6.ListIndex <> -1 Then
             .ComboBox7.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value)(.ComboBox5.Value)(.ComboBox6.Value).keys
         End If
     End With
 End Sub

 Private Sub ClearComb(myStart, myEnd)
     Dim i As Long
     For i = myStart To myEnd
         Me.Controls("ComboBox" & i).Clear
     Next
 End Sub

 Private Sub CommandButton1_Click()
  Dim ctrl As Control, txt1 As String, txt2 As String
    Dim ret As Integer
    For Each ctrl In Me.Controls
        Select Case ctrl.Name
            Case "ComboBox1", "ComboBox2", "ComboBox3", "ComboBox4", "ComboBox5", "ComboBox6", "ComboBox7"
                If Len(Trim$(ctrl.Text)) = 0 Then
                    txt1 = txt1 & ctrl.Name & vbLf
                Else
                    txt2 = txt2 & ctrl.Text & vbLf
                End If
            Case Else
        End Select
    Next
    If Len(txt1) > 0 Then
        MsgBox "以下の値を入力してください" & vbLf & txt1, vbExclamation
        Exit Sub
    Else
        ret = MsgBox("以下の値を入力します" & vbLf & txt2, vbOKCancel)
        If ret <> vbOK Then Exit Sub
    End If
    With Worksheets("SSS").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 9)
        .Value = Array(ComboBox1.Value, ComboBox2.Value, ComboBox3.Value, ComboBox4.Value, _
                ComboBox5.Value, ComboBox6.Value, ComboBox7.Value, TextBox1.Value, TextBox2.Value)
        .Interior.ColorIndex = 3
    End With
    ClearComb 1, 6

    Clear TextBox1
    Clear TextBox2

    ThisWorkbook.Save
 End Sub
（KISS） 2013/11/08(金) 12:24

大変お手数かけました
解決できました

また何かありましたらよろしくお願いいたします
（KISS） 2013/11/08(金) 12:47

[[20131105121455]]　『Comboboxリスト抽出』（KISS）

 Option Explicit

 Private dic As Object

 Private Sub UserForm_Initialize()
     Dim a, i As Long, ii As Long
     Set dic = CreateObject("Scripting.Dictionary")
     dic.CompareMode = 1
     a = Sheets("sss").Cells(1).CurrentRegion.Resize(, 10).Value
     For i = 2 To UBound(a, 1)
         For ii = 1 To UBound(a, 2)
             a(i, ii) = CStr(a(i, ii))
         Next
         If Not dic.exists(a(i, 1)) Then
             Set dic(a(i, 1)) = CreateObject("Scripting.Dictionary")
             dic(a(i, 1)).CompareMode = 1
         End If
         If Not dic(a(i, 1)).exists(a(i, 2)) Then
             Set dic(a(i, 1))(a(i, 2)) = CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2)).exists(a(i, 3)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3)).exists(a(i, 4)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4)).exists(a(i, 5)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5)).exists(a(i, 6)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6)).CompareMode = 1
         End If
         If Not dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6)).exists(a(i, 7)) Then
             Set dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6))(a(i, 7)) = _
             CreateObject("Scripting.Dictionary")
             dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6))(a(i, 7)).CompareMode = 1
         End If
         dic(a(i, 1))(a(i, 2))(a(i, 3))(a(i, 4))(a(i, 5))(a(i, 6))(a(i, 7)) = VBA.Array(a(i, 8), a(i, 9))
     Next
     Me.ComboBox1.List = dic.keys
 End Sub

 Private Sub ComboBox1_Change()
     ClearComb 2, 7
     ClearTB 1, 2
     With Me
         If .ComboBox1.ListIndex <> -1 Then
             .ComboBox2.List = dic(.ComboBox1.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox2_Change()
     ClearComb 3, 7
     ClearTB 1, 2
     With Me
         If .ComboBox2.ListIndex <> -1 Then
             .ComboBox3.List = dic(.ComboBox1.Value)(.ComboBox2.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox3_Change()
     ClearComb 4, 7
     ClearTB 1, 2
     With Me
         If .ComboBox3.ListIndex <> -1 Then
             .ComboBox4.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox4_Change()
     ClearComb 5, 7
     ClearTB 1, 2
     With Me
         If .ComboBox4.ListIndex <> -1 Then
             .ComboBox5.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox5_Change()
     ClearComb 6, 7
     ClearTB 1, 2
     With Me
         If .ComboBox5.ListIndex <> -1 Then
             .ComboBox6.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value)(.ComboBox5.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox6_Change()
     ClearComb 7, 7
     ClearTB 1, 2
     With Me
         If .ComboBox6.ListIndex <> -1 Then
             .ComboBox7.List = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value)(.ComboBox5.Value)(.ComboBox6.Value).keys
         End If
     End With
 End Sub

 Private Sub ComboBox7_Change()
     With Me
         ClearTB 1, 2
         If .ComboBox7.ListIndex <> -1 Then
             .TextBox1.Value = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value)(.ComboBox5.Value)(.ComboBox6.Value)(.ComboBox7.Value)(0)
             .TextBox2.Value = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(.ComboBox4.Value)(.ComboBox5.Value)(.ComboBox6.Value)(.ComboBox7.Value)(1)
         End If
     End With
 End Sub

 Private Sub ClearComb(myStart, myEnd)
     Dim i As Long
     For i = myStart To myEnd
         Me.Controls("ComboBox" & i).Clear
     Next
 End Sub

 Private Sub ClearTB(myStart, myEnd)
    Dim i As Long
    For i = myStart To myEnd
        Me.Controls("TextBox" & i).Value = ""
    Next
 End Sub

 Private Sub CommandButton1_Click()
  Dim ctrl As Control, txt1 As String, txt2 As String
    Dim ret As Integer
    For Each ctrl In Me.Controls
        Select Case ctrl.Name
            Case "ComboBox1", "ComboBox2", "ComboBox3", "ComboBox4", "ComboBox5", "ComboBox6", "ComboBox7", "ComboBox8", "TextBox1", "TextBox2"
                If Len(Trim$(ctrl.Text)) = 0 Then
                    txt1 = txt1 & ctrl.Name & vbLf
                Else
                    txt2 = txt2 & ctrl.Text & vbLf
                End If
            Case Else
        End Select
    Next
    If Len(txt1) > 0 Then
        MsgBox "以下の値を入力してください" & vbLf & txt1, vbExclamation
        Exit Sub
    Else
        ret = MsgBox("以下の値を入力します" & vbLf & txt2, vbOKCancel)
        If ret <> vbOK Then Exit Sub
    End If
    With Worksheets("SSS").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 9)
        .Value = Array(ComboBox1.Value, ComboBox2.Value, ComboBox3.Value, ComboBox4.Value, _
                ComboBox5.Value, ComboBox6.Value, ComboBox7.Value, TextBox1.Value, TextBox2.Value)
        .Interior.ColorIndex = 3
    End With
    ClearComb 1, 7
    ThisWorkbook.Save
 End Sub

（seiya） 2013/11/08(金) 13:01

seiyaさん
有難う御座います
私のやり方と違って
とてもスマートです

有難う御座いました

（KISS） 2013/11/08(金) 13:30

コメント返信：

[ 一覧(最新更新順) ]

[[20131108095901]] 『comboboxをtextboxに変更』（KISS） ページの最後に飛ぶ

[[20131108095901]]　『comboboxをtextboxに変更』（KISS）　ページの最後に飛ぶ