[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コンボボックス連動』（みるる）
いつも大変お世話になっております
ご教示頂けたら幸いです
過去記事にコンボボックス連動についてありましたのを改造しました
ComboBox2クリック時Sheets("list1")からComboBox3のリストを抽出するようにしました
このときに同時に
Sheets("list2")からComboBox4のリストを抽出するようにしたいのですが
どの様にすればよいのでしょうか？
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
両シートともA列は同じ内容が記載されてます
例えば
list1
A B
りんご あいち
りんご あきた
みかん えひめ
みかん くまもと
list2
A B
りんご 佐藤
りんご 宮下
みかん 田中
みかん 山本
この様な感じです
（みるる） 2016/03/16(水) 17:44
コードは3列ですが、両シート共に2列だけですね？
（seiya） 2016/03/16(水) 18:18
ご質問有難う御座います
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
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
宜しくお願いいたします
（みるる） 2016/03/16(水) 18:43
質問内容と参考にしたコードに関連性があるのか不明です。
何をどうしたいのか具体的なシートのレイアウトを掲載して質問した方がよいと思いますが？
できればブックをどこかにアップするとわかりやすいと思いますよ？ 例えば http://firestorage.jp/ （seiya） 2016/03/16(水) 18:56
ご指摘有難う御座います
帰宅後アップさせていただきます
その時は宜しくお願いいたします
おおよそ 20:30くらいになります
会社のPCだとアップできない為
何卒宜しくお願いいたします
（みるる） 2016/03/16(水) 19:02
（みるる） 2016/03/16(水) 21:33
DLしました。 明日になると思いますので... （seiya） 2016/03/16(水) 21:45
ユーザーフォーム１のNコマンドボタンで 新規登録用ユーザーフォーム２が出てくるようにしています
新規登録の発生の所（コンボボックス２）に担当（コンボボックス３）がひも付き（list1)
発生の所（コンボボックス２）に処理（コンボボックス４）がひもつく感じになります(list2)
（みるる） 2016/03/17(木) 09:09
おはようございます。 フォーム(UserForm2)を見ました。 これは、データの追加・削除及び編集を目的としたものですか？
全てComboBoxで絞り込むより、ComboBoxes + ListBox + TextBoxes を併用した方が効率が良いような気がします。 まだよく見ていませんので、後程... （seiya） 2016/03/17(木) 10:02
ご質問有難う御座います
データの追加 になります
ご教示のとおり 全てComboBoxで絞り込むより
おっしゃるとおりと思います
コードのタイピングが正直面倒なので
コピペで済ますため 対外同じにしてしまう
悪い癖があります
反省ですね
（みるる） 2016/03/17(木) 10:08
1) >データの追加 になります
追加のみですか？
削除、編集が無いのなら簡単だと思いますが？
2) list1のB列,C列共に空白がありますが、これはどういうことですか？
3) 部署/役職名 共にリストがあった方がよいのでは？ （seiya） 2016/03/17(木) 11:07
1) >データの追加 になります
list1 ２ 追加 重複削除
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列は ユーザーフォーム１のフィルターに使っています
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列以降は 取引先情報になります
現状ですとコンボックス４のリスト割り当てだと 今後１００件以上になってしまいます
そこで自社現場で絞込みを図りたい所存です
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
有難う御座いました
ものすごく勉強になりました
今後とも宜しくお願いいたします
（みるる） 2016/03/17(木) 15:00
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.