Results of 1 - 1 of about 48798 for A�����������������������... (0.010 sec.)
- [[20131108095901]]
- #score: 1420
- @digest: a98796b95afd7da7470e7145afd57308
- @id: 63797
- @mdate: 2013-11-08T04:30:51Z
- @size: 17922
- @type: text/plain
- #keywords: clearcomb (134145), comparemode (67233), combobox6 (62272), cleartb (56447), combobox5 (54449), combobox7 (49589), combobox4 (46489), combobox3 (37703), mystart (36974), combobox2 (28585), myend (26707), combobox1 (20958), txt1 (17771), combobox8 (15496), txt2 (15172), listindex (13634), ))( (9085), dic (8589), scripting (7693), exists (6944), dictionary (6936), keys (5833), createobject (5649), value (5141), list (4640), controls (4470), private (4419), combobox (4340), change (4169), vbokcancel (3857), control (3771), textbox2 (3301)
- 『comboboxをtextboxに変更』（KISS）
Ver2010 win7 いつも大変お世話になっております 皆様のお力で ある程度形になってきたのですが 仕様変更のため 改造を掛けてるのですが 上手に出来ないため大変申し訳ございませんが 大変お手数と思いますが ご教授をおねがいいたします ユーザーフォームに combobox1〜9配置しておりますが これをCombobox1〜7にして 残りのcombobox8〜9をtextbox1〜2変更したいのですがどの様に改造すればよろしいのでしょうか よろしくお願いいたします 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... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201311/20131108095901.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 96999 documents and 607826 words.
訪問者：