[[20110801145152]]　『ＶＢＡ　コンボボックスの連動について』（ひしょう）　ページの最後に飛ぶ

『ＶＢＡ　コンボボックスの連動について』（ひしょう）

 VBA初心者の割りに要望が高すぎて困っております
どうぞお助けください
見積書を作ろうと悪戦苦闘しております
エクセルシート”Ｌｉｓｔ”に下記のリストがあります
　
項目　　　仕様　　　規格　　　単価　　　部掛
電線　　　ＩＶ　　　　　1.6㎜　　 ２０　　　0.01
電線　　　ＩＶ　　　　　2.0㎜　　 ３０　　　0.015
電線　　　ＨＩＶ　　　　1.6㎜　　 ３５　　　0.012
電線　　　ＨＩＶ　　　　2.0㎜　　 ４５　　　0.022
ケーブル　ＶＶＦ　　　　1.6-2C　　５０　　　0.02
ケーブル　ＶＶＦ　　　　2.0-2C　　７０　　　0.033
ケーブル　ＣＶ　　　　　5.5-3C　　１５０　　0.042
ケーブル　ＣＶ　　　　　8.0-3C　　２５０　　0.055
　
フォームでコンボボタン１，２，３があり
ｺﾝﾎﾞﾎﾞﾀﾝ1で項目の電線・ケーブルのいづれかを選択したら、
たとえば電線を選択したとして、
ｺﾝﾎﾞﾎﾞﾀﾝ2では、IV・HIVが選択でき、IVを選択したら
ｺﾝﾎﾞﾎﾞﾀﾝ3で1.6㎜・2.0㎜を選択できるようにしたいです
そして、フォームの”txt単価”および”txt部掛”に上記で選んだ
うちの単価２０　部掛0.01を反映したいです
どのようにすればよいか教えてください
お願いします
ちなみに、エクセル２００３　WindowsXPです

 コントロールの名前は勝手に合わせてください。(ROUGE)
　
Dim dic As Object
Private Sub ComboBox1_Change()
Me.ComboBox2.Clear
If dic.Exists(Me.ComboBox1.Value) Then
    Me.ComboBox2.List = dic.Item(Me.ComboBox1.Value)
End If
End Sub
Private Sub ComboBox2_Change()
Dim ky
ky = Me.ComboBox1.Value & "_" & Me.ComboBox2.Value
Me.ComboBox3.Clear
If dic.Exists(ky) Then
    Me.ComboBox3.List = dic.Item(ky)
End If
End Sub
Private Sub ComboBox3_Change()
Dim ky
ky = Me.ComboBox1.Value & "_" & Me.ComboBox2.Value & "_" & Me.ComboBox3.Value
Me.TextBox1.Value = Empty: Me.TextBox2.Value = Empty
If dic.Exists(ky) Then
    Me.TextBox1.Value = dic.Item(ky)(0)
    Me.TextBox2.Value = dic.Item(ky)(1)
End If
End Sub
Private Sub UserForm_Initialize()
Dim tbl, x, i As Long, ky, y(), ii As Long
tbl = Sheets("List").Range("A1").CurrentRegion.Resize(, 5).Value
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tbl, 1)
    ky = tbl(i, 1)
    If dic.Exists(ky) Then
        x = dic.Item(ky)
        If IsError(Application.Match(tbl(i, 2), x, 0)) Then
            ReDim Preserve x(UBound(x) + 1)
            x(UBound(x)) = tbl(i, 2)
        End If
        dic.Item(ky) = x
    Else
        dic.Add ky, Array(tbl(i, 2))
        ii = ii + 1
        ReDim Preserve y(1 To ii)
        y(ii) = ky
    End If
    ky = ky & "_" & tbl(i, 2)
    If dic.Exists(ky) Then
        x = dic.Item(ky)
        If IsError(Application.Match(tbl(i, 3), x, 0)) Then
            ReDim Preserve x(UBound(x) + 1)
            x(UBound(x)) = tbl(i, 3)
        End If
        dic.Item(ky) = x
    Else
        dic.Add ky, Array(tbl(i, 3))
    End If
    ky = ky & "_" & tbl(i, 3)
    dic(ky) = Array(tbl(i, 4), tbl(i, 5))
Next
Me.ComboBox1.List = y
End Sub

 アップしたけど、故あって（？）いったん削除。
 バグ修正して再掲。（ほとんどROUGEさんのとかわらないかな）

 Option Explicit

 Dim dic1 As Object
 Dim dic2 As Object
 Dim dic3 As Object
 Dim v As Variant
 Dim skip As Boolean

 Private Sub UserForm_Initialize()
    Dim i As Long
    v = Sheets("List").Range("A1").CurrentRegion.Value
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    Set dic3 = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(v, 1)
        dic1(v(i, 1)) = True
    Next
    ComboBox1.List = dic1.keys
 End Sub

 Private Sub ComboBox1_Change()
    Dim i As Long
    dic2.RemoveAll
    dic3.RemoveAll
    skip = True
    ComboBox2.Clear
    ComboBox3.Clear
    For i = 2 To UBound(v, 1)
        If v(i, 1) = ComboBox1.Value Then dic2(v(i, 2)) = True
    Next
    ComboBox2.List = dic2.keys
    txt単価.Value = Empty
    txt部掛.Value = Empty
    skip = False
 End Sub

 Private Sub ComboBox2_Change()
    Dim i As Long
    If skip Then Exit Sub
    skip = True
    dic3.RemoveAll
    ComboBox3.Clear
    For i = 2 To UBound(v, 1)
        If v(i, 1) = ComboBox1.Value And v(i, 2) = ComboBox2.Value Then
            dic3(v(i, 3)) = Array(v(i, 4), v(i, 5))
        End If
    Next
    ComboBox3.List = dic3.keys
    txt単価.Value = Empty
    txt部掛.Value = Empty
    skip = False
 End Sub

 Private Sub ComboBox3_Change()
    If skip Then Exit Sub
    txt単価.Value = dic3(ComboBox3.Value)(0)
    txt部掛.Value = dic3(ComboBox3.Value)(1)
 End Sub

 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Set dic1 = Nothing
    Set dic2 = Nothing
    Set dic3 = Nothing
 End Sub

 (ぶらっと)

コメント返信：

[ 一覧(最新更新順) ]

[[20110801145152]] 『ＶＢＡ コンボボックスの連動について』（ひしょう） ページの最後に飛ぶ

[[20110801145152]]　『ＶＢＡ　コンボボックスの連動について』（ひしょう）　ページの最後に飛ぶ