[[20160316162447]] 『コンボボックス連動』(みるる) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『コンボボックス連動』(みるる)

いつも大変お世話になっております
ご教示頂けたら幸いです

過去記事にコンボボックス連動についてありましたのを改造しました
ComboBox2クリック時Sheets("list1")からComboBox3のリストを抽出するようにしました
このときに同時に
Sheets("list2")からComboBox4のリストを抽出するようにしたいのですが
どの様にすればよいのでしょうか?

[[20131105121455]]

 
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("list1").Cells(1).CurrentRegion.Resize(, 3).Value

     For i = 1 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("System.Collections.ArrayList")
         End If
         dic(a(i, 1))(a(i, 2))(a(i, 3)).Add i
     Next
   Me.ComboBox2.List = dic.keys

End Sub

  Private Sub ComboBox2_Click()
   Dim W As Worksheet
    For Each W In Worksheets
        If W.AutoFilterMode Then W.AutoFilterMode = False
    Next W

    With Me
        .ComboBox3.Clear

    If .ComboBox2.ListIndex > -1 Then .ComboBox3.List = dic(.ComboBox2.Value).keys

    End With

End Sub

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 >Sheets("list2")からComboBox4のリストを抽出するようにしたいのですが 
 Sheets("list2")とSheets("list1")の関連性を具体的に説明してください。
(seiya) 2016/03/16(水) 17:30

seiya様
早速のご質問有難う御座います

両シートともA列は同じ内容が記載されてます
例えば
list1
A      B
りんご   あいち
りんご   あきた
みかん   えひめ
みかん   くまもと

list2
A        B
りんご     佐藤
りんご     宮下
みかん     田中
みかん     山本

この様な感じです

(みるる) 2016/03/16(水) 17:44


 コードは3列ですが、両シート共に2列だけですね?

(seiya) 2016/03/16(水) 18:18


seiya様

ご質問有難う御座います
ComboBox4には下記に様にしております

宜しくお願いいたします

Private Sub ComboBox4_Change()

Dim idx As Long

    idx = ComboBox4.ListIndex
    ComboBox5.ListIndex = idx
    ComboBox6.ListIndex = idx
    ComboBox7.ListIndex = idx
    ComboBox8.ListIndex = idx
    ComboBox9.ListIndex = idx
    ComboBox10.ListIndex = idx
    ComboBox11.ListIndex = idx
    ComboBox12.ListIndex = idx
    ComboBox13.ListIndex = idx
   ComboBox14.ListIndex = idx

End Sub
(みるる) 2016/03/16(水) 18:23


Private Sub UserForm_Initialize()
Dim r As Range
Dim s As Range
Dim a, i As Long, ii As Long

Dim ixc As Integer

    Set s = Worksheets("list2").Range("B2", Worksheets("list2").Cells(Rows.Count, 1).End(xlUp))

   ComboBox4.List = s.Offset(, 1).Value
    ComboBox5.List = s.Offset(, 2).Value
    ComboBox6.List = s.Offset(, 3).Value
    ComboBox7.List = s.Offset(, 4).Value
    ComboBox8.List = s.Offset(, 5).Value
    ComboBox9.List = s.Offset(, 6).Value
    ComboBox10.List = s.Offset(, 7).Value
    ComboBox11.List = s.Offset(, 8).Value
    ComboBox12.List = s.Offset(, 9).Value
    ComboBox13.List = s.Offset(, 10).Value
   ComboBox14.List = s.Offset(, 11).Value

(みるる) 2016/03/16(水) 18:26


コード3列 と言うのは解ったのですが
2列に変更が出来ませんでした
また list1は2列です

宜しくお願いいたします
(みるる) 2016/03/16(水) 18:43


 質問内容と参考にしたコードに関連性があるのか不明です。

 何をどうしたいのか具体的なシートのレイアウトを掲載して質問した方がよいと思いますが?

 できればブックをどこかにアップするとわかりやすいと思いますよ?
 例えば
http://firestorage.jp/
(seiya) 2016/03/16(水) 18:56

seiya様

ご指摘有難う御座います
帰宅後アップさせていただきます

その時は宜しくお願いいたします
おおよそ 20:30くらいになります
会社のPCだとアップできない為

何卒宜しくお願いいたします
(みるる) 2016/03/16(水) 19:02


大変遅くなりました
アップさせていただきます
ご教授お願いいたします

(みるる) 2016/03/16(水) 21:33


 DLしました。
 明日になると思いますので...
(seiya) 2016/03/16(水) 21:45

お手すきな時で構いません
よろしくお願いたします
(みるる) 2016/03/16(水) 22:48

おはよう御座います
説明不要と思いますが

ユーザーフォーム1のNコマンドボタンで 新規登録用ユーザーフォーム2が出てくるようにしています

新規登録の発生の所(コンボボックス2)に担当(コンボボックス3)がひも付き(list1)
発生の所(コンボボックス2)に処理(コンボボックス4)がひもつく感じになります(list2)  
(みるる) 2016/03/17(木) 09:09


 おはようございます。
 フォーム(UserForm2)を見ました。
 これは、データの追加・削除及び編集を目的としたものですか?

 全てComboBoxで絞り込むより、ComboBoxes + ListBox + TextBoxes を併用した方が効率が良いような気がします。
 まだよく見ていませんので、後程...
(seiya) 2016/03/17(木) 10:02

seiya様

ご質問有難う御座います

データの追加  になります

ご教示のとおり 全てComboBoxで絞り込むより
おっしゃるとおりと思います

コードのタイピングが正直面倒なので

コピペで済ますため  対外同じにしてしまう
悪い癖があります

反省ですね

(みるる) 2016/03/17(木) 10:08


 1) >データの追加  になります 
    追加のみですか?
    削除、編集が無いのなら簡単だと思いますが?

 2) list1のB列,C列共に空白がありますが、これはどういうことですか?

 3) 部署/役職名 共にリストがあった方がよいのでは?
(seiya) 2016/03/17(木) 11:07

ご質問有難う御座います

 1) >データの追加  になります 

list1 2 追加 重複削除

 Sheets("list2").Select
           ActiveSheet.Range("A1:J1000").RemoveDuplicates Columns:=Array(2, 7), Header:=xlYes
           Sheets("list1").Select
           ActiveSheet.Range("A1:J1000").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

main    追加 のみになります

list1 B列 空白はまだ完成していないための  取り合えずで作ったものですので完成時は埋まる予定です

   C列は ユーザーフォーム1のフィルターに使っています
   Private Sub CMBYY_Change()
On Error Resume Next

  With Worksheets("main")

         .Range("A1").AutoFilter Field:=1, _
                           Operator:=xlFilterValues, _
                           Criteria2:=Array(0, CMBYY.Value)
    End With
End Sub

 3) 部署/役職名 共にリストがあった方がよいのでは?

については 確かにおっしゃられるとおりですが
自分の力量では難しいと判断しまして諦めた所存です

(みるる) 2016/03/17(木) 11:33


 list1 と list2を関連付ける項目は何ですか?

 例えば
 list2の 2行目は 
 札幌営業所 担当者 井沼
 になっていますが、

 list1の札幌営業所には

 藤本
 小野寺
 山田
 で「井沼」はありません。
(seiya ) 2016/03/17(木) 12:04

ご質問有難う御座います

list1  A列 自社現場 B列 自社担当者です
list2  A列 自社現場 B列以降は 取引先情報になります

現状ですとコンボックス4のリスト割り当てだと 今後100件以上になってしまいます
そこで自社現場で絞込みを図りたい所存です 

mainのC列がlist1 B列

mainのD列以降が list2 B列以降になります
(みるる) 2016/03/17(木) 12:13


 ということは、第一段階として

 1) ComboBox2で list1 A列のユニーク値を表示

 2) ComboBox3 で 1)に関連する list1B列を表示

 3) ComboBox4に 1) で選択された [発生場所] に関連した [会社名]を表示させる。

 上記全て選択状態になったら、[会社名]に関連した詳細情報を掲載。

 ということですか?
(seiya ) 2016/03/17(木) 12:31

そのとおりで御座います

複雑作業で申し訳御座いません
(みるる) 2016/03/17(木) 13:14


 UserForm3を作成(デザインは無視)

 ComboBox x 3 ComboBox2- 4
 TextBox x 10 TextBox1 - 10

 を配置

 CMBYY, CMBMM, CMBDD はそのまま
 CMBDDのリストは 年月の日数に対応

 Option Explicit

 Private dic As Object

 Private Sub UserForm_Initialize()
    Dim a, i As Long, ii As Long, w, temp
    Set dic = CreateObject("Scripting.Dictionary")
    a = Sheets("list1").Cells(1).CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dic.exists(a(i, 1)) Then
            ReDim w(1 To 2)
            Set w(1) = CreateObject("Scripting.Dictionary")
            Set w(2) = CreateObject("Scripting.Dictionary")
            dic(a(i, 1)) = w
        End If
        dic(a(i, 1))(1)(a(i, 2)) = Empty
    Next
    a = Sheets("list2").Cells(1).CurrentRegion.Value
    ReDim temp(1 To 10)
    For i = 2 To UBound(a, 1)
        If dic.exists(a(i, 1)) Then
            For ii = 3 To UBound(a, 2)
                temp(ii - 2) = a(i, ii)
            Next
            dic(a(i, 1))(2)(a(i, 2)) = temp
        End If
    Next
    With Me.CMBYY
        .List = [year(today())-3+row(1:6)]: .ListIndex = 2
    End With
    With Me.CMBMM
        .List = [row(1:12)]: .ListIndex = Month(Date) - 1
    End With
    temp = GetDayList(DateSerial(Val(Me.CMBYY.Value), Val(Me.CMBMM.Value), 1))
    With Me.CMBDD
        .List = temp: .ListIndex = Day(Date) - 1
    End With
    Me.ComboBox2.List = dic.keys
End Sub

 Private Sub ComboBox2_Change()
    Clear_TB 1, 10
    Clear_CB 3, 4
    If Me.ComboBox2.ListIndex > -1 Then
        Me.ComboBox3.List = dic(Me.ComboBox2.Value)(1).keys
        Me.ComboBox4.List = dic(Me.ComboBox2.Value)(2).keys
    End If
End Sub

 Private Sub ComboBox4_Change()
    Dim i As Long
    Clear_TB 1, 10
    If Me.ComboBox4.ListIndex > -1 Then
        For i = 1 To 10
            Me("textbox" & i).Value = dic(Me.ComboBox2.Value)(2)(Me.ComboBox4.Value)(i)
        Next
    End If
End Sub

 Private Sub CMBYY_Click()
    If (Me.CMBYY.ListIndex > -1) * (Me.CMBMM.ListIndex > -1) Then
        Me.CMBDD.List = GetDayList(DateSerial(Val(Me.CMBYY), Val(Me.CMBMM), 1))
    End If
End Sub

 Private Sub CMBMM_Click()
    If (Me.CMBYY.ListIndex > -1) * (Me.CMBMM.ListIndex > -1) Then
        Me.CMBDD.List = GetDayList(DateSerial(Val(Me.CMBYY), Val(Me.CMBMM), 1))
    End If
End Sub

 Private Sub Clear_TB(s As Long, f As Long)
    Dim i As Long
    For i = s To f
        Me("textbox" & i).Value = ""
    Next
End Sub

 Private Sub Clear_CB(s As Long, f As Long)
    Dim i As Long
    For i = s To f
        Me("combobox" & i).Clear
    Next
End Sub

 Function GetDayList(myDate As Date)
    Dim x
    x = Day(DateAdd("m", 1, myDate) - 1)
    GetDayList = Evaluate("row(1:" & x & ")")
End Function

 ファイルをアップ

http://firestorage.jp/download/c8e237fb42be8989878f39d3d388104958530b4e

 Download Password:d0scyj5r
(seiya ) 2016/03/17(木) 14:05

seiyaさま

有難う御座いました
ものすごく勉強になりました

今後とも宜しくお願いいたします
(みるる) 2016/03/17(木) 15:00


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.