[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コンボボックス連動』(みるる)
いつも大変お世話になっております
ご教示頂けたら幸いです
過去記事にコンボボックス連動についてありましたのを改造しました
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
ユーザーフォーム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
ご質問有難う御座います
データの追加 になります
ご教示のとおり 全て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
有難う御座いました
ものすごく勉強になりました
今後とも宜しくお願いいたします
(みるる) 2016/03/17(木) 15:00
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.