Results of 1 - 1 of about 8932 for リスト (0.007 sec.)
- [[20210302204123]]
- #score: 2746
- @digest: 62b5afef22da1ff5def401878c84f159
- @id: 86885
- @mdate: 2021-03-09T10:23:14Z
- @size: 36051
- @type: text/plain
- #keywords: diclist (651553), arydata (385079), cbs (143013), 小小 (143013), setcombobox (132160), listexistscheck (125474), 燥肌 (121718), 乾燥 (82782), cmdok (68173), 小分 (60569), enabled (54003), 中分 (53573), 類→ (45757), rownum (40620), 分類 (37772), combobox4 (29271), idx (22758), combobox3 (20108), 大分 (19632), cstr (13737), combobox2 (12100), combobox (11285), hatena (10829), dictionary (10390), controls (10211), userform (7656), 店舗 (7292), ボボ (7080), private (6956), combobox1 (6067), 北海 (5909), click (5589)
- 『ドロップダウンリストをVBAで』（乾燥肌）
現在、2段階のドロップダウンリストを使用しておりますが、 それでも選択肢が多いです（それぞれ選択肢が50程度）。 既存のドロップダウンリストでは表示数が8個しかなく、 また、マウスホイールで上下移動ができないため不便を感じております。 そのため、VBAで多数の選択肢を表示可能な2段階or3段階のドロップダウンリストを作成したいのですが、 当方、VBAを学び始めて1ヶ月ほどのため、基礎的な処理はある程度できますが、ドロップダウンリストはどのように作れば良いか、全く分からず頓挫しております。 どなたかお助けいただけないでしょうか。 ＜ 使用 Excel:Excel2016、使用 OS:Windows10 ＞ ---- https://excel-ubara.com/excelvba3/EXCELFORM018.html （推奨） 2021/03/02(火) 21:00 ---- おはようございます ^^ いろんな方法が有るとは思いますが、一案 で。いずれにいたしましても、三連させる なら大、中、小、分類で三シートに分けて リレーショナブルなリスト情報を作成する と比較的、解りやすい様な気がいたします。 範囲名を乱用すると、。。私は混乱しやす いので。^^; オフセットと、リサイズ方式で、リスト情 報さえ、作成してしまえば、あとは、入力 規則作成するだけの様に思いますです。。 。いや。。。ほんと思うだけで。。。あい すみません。。m(_ _)m （隠居じーさん） 2021/03/03(水) 06:34 ---- 確認が遅くなり申し訳ございません。 お二方ともありがとうございます。 推奨様のリンク先を元に2段階のコンボボックスを作成してみました。 文字サイズ等も自由に設定でき、使いやすいと感じました。 現在以下のようになっております。 ________________________________ Private Sub UserForm_Initialize() aryテスト = Worksheets("動作テスト").Cells(1, 1).CurrentRegion Dim i As Long With Me.cmbテスト1 .Clear For i = 1 To UBound(aryテスト, 2) .AddItem aryテスト(1, i) Next End With End Sub ________________________________ Private aryテスト Private Sub cmbテスト1_Change() Dim i As Long Dim j As Long j = Me.cmbテスト1.ListIndex + 1 With Me.cmbテスト2 .Clear For i = 2 To UBound(aryテスト, 1) If aryテスト(i, j) <> "" Then .AddItem aryテスト(i, j) End If Next End With End Sub ________________________________ お聞きしたいのですが、 大分類→中分類 で終わるものもあれば、 大分類→中分類→小分類 で終わるものもあれば、 大分類→中分類→小分類→小小分類 で終わるものもあります。 中分類で終わりの場合、これで終わりと分かるようにしたいです。 逆に、小分類まである場合、小分類まで選択していないと「小分類まで選択して下さい」のようなポップアップ表示を出したいです。 どのようなコードを組めばよいでしょうか? また、その場合、各シートへのデータはどのように保存すると管理しやすいのでしょうか? 難しいと思いますが、よろしくお願いします。 （乾燥肌） 2021/03/04(木) 10:46 ---- おはようございます ^^ シート名 データ一覧 |[A] |[B] |[C] [1]|都道府県名|店舗名 |顧客名 [2]|愛知県 |CBW-店舗|顧客Y001AV [3]|愛知県 |CBW-店舗|顧客G001XQ |[A] |[B] |[C] [18647]|和歌山県|NHL-店舗|顧客W047PG [18648]|和歌山県|NHL-店舗|顧客X047JG シート名 Large |[A] [1]|大分類 [2]|北海道 [3]|青森県 |[A] [46]|宮崎県 [47]|鹿児島県 [48]|沖縄県 シート名 Medium |[A] |[B] [1]|上位分類|中分類 [2]|北海道 |ITU-店舗 [3]|北海道 |ZTX-店舗 [4]|北海道 |LYP-店舗 シート名 Small |[A] |[B] [1]|上位分類 |小分類 [2]|北海道_ITU-店舗|顧客T046BM [3]|北海道_ITU-店舗|顧客E046ND [4]|北海道_ITU-店舗|顧客L046DM [5]|北海道_ITU-店舗|顧客A046TO [6]|北海道_ITU-店舗|顧客J046YZ みたいな感じです。都道府県名、若しくは、上位分類で並び替 えしてます。 後は、マクロなしで、数式のOFFSET関数、 MATCH、COUNTIF、COUNTA、等を使用して入力 規則のリストを作成するかご希望の様に付録便利機能を付ける場 合は、シートのCHANGEイベントを活用して、最初の大分類 プルダウン以外はマクロで毎回、大分類のプルダウン時にマクロ で自動作製するかですね。←この場合、大分類のセル値が変わら ないと中分類以降は作成されませんので、注意喚起は必要ないか もと思いすです。^^; 一度作成すれば。。。ですが。。。元のデータ一覧に匹敵する情 報が、度々更新される場合はデーターのコンバート[シート作成] もマクロですれば便利です。と思います。でわでわ。頑張ってく ださいね。m(_ _)m （隠居じーさん） 2021/03/04(木) 11:30 ---- ＞＞お聞きしたいのですが、 ＞＞ 大分類→中分類 で終わるものもあれば、 ＞＞ 大分類→中分類→小分類 で終わるものもあれば、 ＞＞ 大分類→中分類→小分類→小小分類 で終わるものもあります。 情報も、分ける、基準も想像でしかありませんので。断言は出来ませんが。 ひとつづつ分けて別入力とした方が、不測の事態を軽減できるような気が 致します。私の頭がショートしてきましたので。他の回答者様のアドバイ スを、お待ちくださいませ。お役に立てず、相済みませんでした。<< _ _ >> （隠居じーさん） 2021/03/04(木) 12:34 ---- ＞中分類で終わりの場合、これで終わりと分かるようにしたいです。 単なる思いつきですが、 終わりになるものには、表示する文字列の最後に "業種A/" のようにスラッシュをつけるようにしてはどうですか? Right(s,1) が"/"で無いときだけ、下位の分類を表示すればよいのでは? スラッシュをつけるのは表示だけであって、 処理に使用する文字列は、スラッシュを消去したものを使います。 （γ） 2021/03/04(木) 14:48 ---- ユーザーフォームを開いた直後は、 「大分類」以外は使用不可(Enabled=False)にしておいて、 選択したときに、次のコンボボックスのリストがあったら、 使用可能にしていくというユーザーインターフェイスはどうでしょうか。 リストデータの持ち方は、下記のような感じが扱いやすそうです。 大分類 中分類 小分類 小小分類 A a あ ア A a あ イ A a い ウ A b う A b 重複が出るのでDictionaryで重複排除したリストを作成するようにすればいいでしょう。 Dictionaryのアイテムに次のリストのDictionaryを格納するようにするといいですね。 以前、そのようなものを作成したことがあります。 （hatena） 2021/03/04(木) 16:03 ---- 大、中、小、小小・・・に分けられる分類リストを試作してみました。 重層化対応でコンマ区切りの文字列にしています。 コンマの個数またはSplitしたときのUboundの値超えで子分類無しの判定ができれば。 Function Sample(rng As Range) As Variant Dim dic As Object Dim tmp As Variant Dim var As Variant Dim str As String Dim i As Long, j As Long, k As Long Set dic = CreateObject("Scripting.Dictionary") var = rng.Value ReDim tmp(0 To UBound(var, 2) - 1) For i = 1 To UBound(var, 2) For j = 1 To UBound(var, 1) For k = 1 To i If IsEmpty(var(j, k)) Then Exit For str = str & var(j, k) & "," Next k str = Left(str, Len(str) - 1) If Not dic.exists(str) Then dic.Add str, str str = "" Next j tmp(i - 1) = dic.keys dic.RemoveAll Next i Sample = tmp End Function （Sinking Time） 2021/03/04(木) 16:38 ---- 隠居じーさん様 ありがとうございます。 データリスト作成時に参考にさせていただきます。 γ様 ありがとうございます。 "/"を利用する方法、参考にさせていただきます。 hatena様 ありがとうございます。 リスト作成に関して、参考にさせていただきます。 Sinking Time様 ありがとうございます。 今日は時間がないため、週末に確認させていただきます。 （乾燥肌） 2021/03/05(金) 09:14 ---- 拙い頭を捻ってまた試作してみました。 「動作テスト」シートのA1から分類リストを作成し A列を大分類 B列を中分類 C列を小分類 D列を小小分類 にしてください。 ユーザーフォームをつくり 「Label_l」「Label_m」「Label_s」「Label_ss」 「ComboBox_l」「ComboBox_m」「ComboBox_s」「ComboBox_ss」 を置いてください。 下記のコードをユーザーフォームのモジュールに写してください。 下の階層の分類があれば新たにコンボボックスが現れます。 下の階層の分類がなければメッセージボックスに表示します。 Private Const DLT As String = "," '←データの中に「,」が含まれる場合は誤作動するのでここを別の文字に変える Private Classification As Variant Private cName(1) As String Private cVol(3) As String Private Str(3) As String Private Sub UserForm_Initialize() Classification = Sample(Worksheets("動作テスト").Cells(1, 1).CurrentRegion) cName(0) = "Label" cName(1) = "ComboBox" cVol(0) = "_l" cVol(1) = "_m" cVol(2) = "_s" cVol(3) = "_ss" Str(1) = "(中分類なし)" Str(2) = "(小分類なし)" Str(3) = "(小小分類なし)" With Me.Controls(cName(1) & cVol(0)) .Clear .List = Classification(0) End With ControlsVisible False, 1 End Sub Private Sub ComboBox_l_click() Sample0 0 End Sub Private Sub ComboBox_m_click() Sample0 1 End Sub Private Sub ComboBox_s_click() Sample0 2 End Sub Private Sub ComboBox_ss_Click() Sample0 3 End Sub Private Sub Sample0(n) Select Case True Case Me.Controls(cName(1) & cVol(n)).Value = Str(n): Sample1 n - 1 Case n = UBound(cVol): Sample1 n Case Else: Sample2 n End Select End Sub Private Sub Sample1(n) Dim tmp As String Dim i As Long For i = LBound(cVol) To n tmp = tmp & Me.Controls(cName(1) & cVol(i)).Value & DLT Next tmp = Left(tmp, Len(tmp) - Len(DLT)) ControlsVisible False, n + 1 MsgBox tmp End Sub Private Sub Sample2(n) Dim tmp() As String Dim v As Variant Dim n1 As Long Dim i As Long, j As Long n1 = n + 1 ControlsVisible False, n1 ReDim tmp(LBound(Classification(n1)) To UBound(Classification(n1))) j = LBound(tmp) - 1 For i = LBound(Classification(n1)) To UBound(Classification(n1)) v = Split(Classification(n1)(i), DLT) If Sample3(v, n) Then j = j + 1 If UBound(v) > n Then tmp(j) = v(n1) Else tmp(j) = Str(n1) End If End If Next i If j >= LBound(tmp) Then ReDim Preserve tmp(j) ControlsVisible True, n1 With Me.Controls(cName(1) & cVol(n1)) .Clear .List = tmp End With If j = LBound(tmp) And tmp(LBound(tmp)) = Str(n1) Then Sample1 n End If End Sub Private Function Sample3(v, n) As Boolean Dim i As Long For i = LBound(v) To n Select Case True Case i > UBound(v): Exit Function Case Me.Controls(cName(1) & cVol(i)).Value <> v(i): Exit Function End Select Next i Sample3 = True End Function Private Sub ControlsVisible(IsVisible As Boolean, n As Long) Dim lb As Long, ub As Long Dim i As Long, j As Long If n < LBound(cVol) Or n > UBound(cVol) Then Exit Sub If IsVisible Then lb = LBound(cVol): ub = n Else lb = n: ub = UBound(cVol) End If For i = lb To ub For j = LBound(cName) To UBound(cName) Me.Controls(cName(j) & cVol(i)).Visible = IsVisible Next Next End Sub Function Sample(rng As Range) As Variant Dim dic As Object Dim tmp As Variant Dim var As Variant Dim Str As String Dim i As Long, j As Long, k As Long Set dic = CreateObject("Scripting.Dictionary") var = rng.Value ReDim tmp(0 To UBound(var, 2) - 1) For i = 1 To UBound(var, 2) For j = 1 To UBound(var, 1) For k = 1 To i If IsEmpty(var(j, k)) Then Exit For Str = Str & var(j, k) & DLT Next k Str = Left(Str, Len(Str) - Len(DLT)) If Not dic.exists(Str) Then dic.Add Str, Str Str = "" Next j tmp(i - 1) = dic.keys dic.RemoveAll Next i Sample = tmp End Function （Sinking Time） 2021/03/05(金) 15:19 ---- 「以前、そのようなものを作成したことがあります。」と上の回答で書きましたが、見つけました。 下記で回答してました。 VBA - VBA ユーザーフォーム コンボボックスについて|teratail https://teratail.com/questions/297359 DictionaryのKeyにリストを格納して、アイテムに次のリストのDictionaryを格納する、という入れ子構造にすべてのリストを格納して、コンボボックスを選択したときにそのリストを取得するというロジックになってます。これを元に今回の要件にあうように改造してみました。 リストデータは 「ListData」シートに下記のように入力します。 大分類 中分類 小分類 小小分類 A a あ ア A a あ イ A a い ウ A b う A b ユーザーフォームにはコンボボックスを4つ（ComboBox1, ComboBox2, ComboBox3, ComboBox4）、 コマンドボタンを2つ（cmdCancel, cmdCancel）配置します。（cmdCancel, cmdOK） Option Explicit Dim dicList(1 To 4) As Dictionary '分類リスト格納用連想配列 Dim CBs(1 To 4) As MSForms.ComboBox Private Sub cmdCancel_Click() Unload Me End Sub Private Sub cmdOK_Click() '選択したリストを使った処理 Unload Me End Sub Public Sub SetComboBox(Idx As Long) If dicList(Idx).Exists(CBs(Idx).Text) Then Set dicList(Idx + 1) = dicList(Idx)(CBs(Idx).Text) If Join(dicList(Idx + 1).Keys) = "" Then Me.cmdOK.Enabled = True Else CBs(Idx + 1).Enabled = True CBs(Idx + 1).List = dicList(Idx + 1).Keys Dim i As Long For i = Idx + 1 To 4 CBs(i).Value = "" Next For i = Idx + 2 To 4 CBs(i).Enabled = False Next Me.cmdOK.Enabled = False End If End If End Sub Private Sub ComboBox1_Click() Call SetComboBox(1) End Sub Private Sub ComboBox2_Click() Call SetComboBox(2) End Sub Private Sub ComboBox3_Click() Call SetComboBox(3) End Sub Private Sub ComboBox4_Click() If CBs(4).Text <> "" Then Me.cmdOK.Enabled = True End Sub Private Sub UserForm_Initialize() Set CBs(1) = Me.ComboBox1 Set CBs(2) = Me.ComboBox2 Set CBs(3) = Me.ComboBox3 Set CBs(4) = Me.ComboBox4 CBs(2).Enabled = False CBs(3).Enabled = False CBs(4).Enabled = False Me.cmdOK.Enabled = False Dim aryData() With Worksheets("ListData").Range("A1").CurrentRegion aryData = .Offset(1).Resize(.Rows.Count - 1).Value End With Set dicList(1) = New Dictionary Dim i As Long For i = 1 To UBound(aryData) Call ListExistsCheck(dicList(1), dicList(2), aryData(i, 1)) Call ListExistsCheck(dicList(2), dicList(3), aryData(i, 2)) Call ListExistsCheck(dicList(3), dicList(4), aryData(i, 3)) dicList(4)(CStr(aryData(i, 4))) = aryData(i, 4) Set dicList(3)(CStr(aryData(i, 3))) = dicList(4) Set dicList(2)(CStr(aryData(i, 2))) = dicList(3) Set dicList(1)(CStr(aryData(i, 1))) = dicList(2) Next CBs(1).List = dicList(1).Keys End Sub '子のDictionaryを取得、存在しなければ新規に生成 Public Sub ListExistsCheck(dicListP As Dictionary, dicListC As Dictionary, key) If dicListP.Exists(CStr(key)) Then Set dicListC = dicListP(CStr(key)) Else Set dicListC = New Dictionary End If End Sub ユーザーフォームを開いた直後は「大分類」コンボのみ使用できるようになってます。 リストを選択すると次のコンボボックスが使用できるようになります。 次の分類リストがないときは、cmdOK が使用可能になります。 このクリック時に選択した分類を使った処理を記述するといいでしょう。 もし、前のコンボボックスに戻って選択しなおしたときは、 以降のコンボボックスをリセットします。 （hatena） 2021/03/06(土) 02:01 ---- Sinking Time様 hatena様 ありがとうございます。 初心者の私ではわからない部分が多数あり、何とか調べながら理解している最中ですが、 ご提示いただいた通りに実行しただけでは コンパイルエラー: ユーザー定義型は定義されていません。 と表示されてしまいます。 現在、 ・Visual Basic For Applications ・Microsoft Excel 15.0 Object Library ・OLE Automation ・Microsoft Office 15.0 Object Library ・Microsoft Forms 2.0 Object Library 上記5つが有効になっておりますが、追加や更新等が必要なのでしょうか? よろしくお願いします。 （乾燥肌） 2021/03/07(日) 20:08 ---- ＞上記5つが有効になっておりますが、追加や更新等が必要なのでしょうか? 心配ご無用。一切必要ありません。ありません。 （KAN） 2021/03/07(日) 20:43 ---- Microsoft Scripting Runtime 参照設定だと思います。あとボタンのオブ ジェクト名を合わせると、（hatena）さん 2021/03/06(土) 02:01のコード 当方では動きましたですよ。(#^^#)v 連想配列使いとか、纏め方が素晴らしいですね ( ..)φメモメモ とても勉強になりました←頭のショートが 治まったような気が。。。(◎_◎;)でわでわ m(__)m （隠居じーさん） 2021/03/07(日) 22:37 ---- 隠居じーさん様 ありがとうございます。 Microsoft Scripting Runtime を有効にしたら無事動作しました。 （乾燥肌） 2021/03/08(月) 09:00 ---- hatena様 非常に良くできているのですが、 1点不備がありまして…。 大分類 中分類 小分類 小小分類 A県 B県 1市 B県 2市 a区 B県 2市 b区 ああ B県 2市 b区 いい ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ 上のようなデータの中から 「B県 2市 b区 いい」 まで選択した後、「A県」に変えた場合、 A県の中分類、小分類、小小分類リストにB県のデータが適応されたままになっています。 これはどのようにすれば対処できますでしょうか? また、可能であれば、「クリア」というボタンを押すことで 大、中、小、小小の選択状況をリセットしたいです。 何度もお願いしてしまい申し訳ありませんが、よろしくお願いいたします。 （乾燥肌） 2021/03/08(月) 10:26 ---- クリアボタンを押した場合に各ドロップダウンリストで選択されているものをリセットしたいのですが、 dicListをRemoveAllにてクリアした場合、何か不備が生じますでしょうか? （乾燥肌） 2021/03/08(月) 13:18 ---- クリアボタンを押した際の動作を以下のようにしてみました。 Private Sub cmdクリア_Click() UserForm.Controls("ComboBox1") = "" UserForm.Controls("ComboBox2") = "" UserForm.Controls("ComboBox3") = "" UserForm.Controls("ComboBox4") = "" Me.ComboBox2.Enabled = False Me.ComboBox3.Enabled = False Me.ComboBox4.Enabled = False End Sub （乾燥肌） 2021/03/08(月) 14:19 ---- 上位のコンボボックスを変更した際に、下位の内容をクリアするよう、自分なりに組んでみました。 Private Sub ComboBox1_Click() UserForm.Controls("ComboBox2") = "" UserForm.Controls("ComboBox3") = "" UserForm.Controls("ComboBox4") = "" Me.ComboBox2.Enabled = False Me.ComboBox3.Enabled = False Me.ComboBox4.Enabled = False Call SetComboBox(1) End Sub Private Sub ComboBox2_Click() UserForm.Controls("ComboBox3") = "" UserForm.Controls("ComboBox4") = "" Me.ComboBox3.Enabled = False Me.ComboBox4.Enabled = False Call SetComboBox(2) End Sub Private Sub ComboBox3_Click() UserForm.Controls("ComboBox4") = "" Me.ComboBox4.Enabled = False Call SetComboBox(3) End Sub （乾燥肌） 2021/03/08(月) 14:39 ---- 大分類 中分類 小分類 小小分類 料金 A県 1,000 B県 1市 1,200 B県 2市 a区 1,350 B県 2市 b区 ああ 1,500 B県 2市 b区 いい 1,700 ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ 上記のように、いずれのデータも「E列」に料金（数値のみ）が入力されている場合、 例えば、B県 2市 a区をコンボボックスで選択した際に「1,350」と分かるようにしたいのですが、 どのように組めばよいでしょうか? よろしくお願いいたします。 （乾燥肌） 2021/03/08(月) 15:01 ---- 5列目の料金をテキストボックスに表示できるようにしてみました ユーザーフォームにテキストボックス「TextBox1」を追加します。 このテキストボックスに料金を表示します。 Option Explicit Dim dicList(1 To 4) As Dictionary '分類リスト格納用連想配列 Dim CBs(1 To 4) As MSForms.ComboBox Private Sub cmdCancel_Click() Unload Me End Sub Private Sub cmdOK_Click() '選択したリストを使った処理 Unload Me End Sub Public Sub SetComboBox(Idx As Long) If dicList(Idx).Exists(CBs(Idx).Text) Then If IsObject(dicList(Idx)(CBs(Idx).Text)) Then Set dicList(Idx + 1) = dicList(Idx)(CBs(Idx).Text) CBs(Idx + 1).Enabled = True CBs(Idx + 1).List = dicList(Idx + 1).Keys Dim i As Long For i = Idx + 1 To 4 CBs(i).Value = "" Next For i = Idx + 2 To 4 CBs(i).Enabled = False Next Me.cmdOK.Enabled = False Me.TextBox1.Value = "" Else Me.cmdOK.Enabled = True Me.TextBox1.Value = dicList(Idx)(CBs(Idx).Text) End If End If End Sub Private Sub ComboBox1_Click() Call SetComboBox(1) End Sub Private Sub ComboBox2_Click() Call SetComboBox(2) End Sub Private Sub ComboBox3_Click() Call SetComboBox(3) End Sub Private Sub ComboBox4_Click() If CBs(4).Text <> "" Then Me.cmdOK.Enabled = True Me.TextBox1.Value = dicList(4)(CBs(4).Text) End If End Sub Private Sub UserForm_Initialize() Set CBs(1) = Me.ComboBox1 Set CBs(2) = Me.ComboBox2 Set CBs(3) = Me.ComboBox3 Set CBs(4) = Me.ComboBox4 CBs(2).Enabled = False CBs(3).Enabled = False CBs(4).Enabled = False Me.cmdOK.Enabled = False Dim aryData() With Worksheets("ListData").Range("A1").CurrentRegion aryData = .Offset(1).Resize(.Rows.Count - 1).Value End With Set dicList(1) = New Dictionary Dim i As Long For i = 1 To UBound(aryData) Call ListExistsCheck(dicList(1), dicList(2), aryData(i, 1)) Call ListExistsCheck(dicList(2), dicList(3), aryData(i, 2)) Call ListExistsCheck(dicList(3), dicList(4), aryData(i, 3)) dicList(4)(CStr(aryData(i, 4))) = aryData(i, 5) If CStr(aryData(i, 4)) = "" Then Set dicList(3)(CStr(aryData(i, 3))) = aryData(i, 5) Else Set dicList(3)(CStr(aryData(i, 3))) = dicList(4) End If If CStr(aryData(i, 3)) = "" Then Set dicList(2)(CStr(aryData(i, 2))) = aryData(i, 5) Else Set dicList(2)(CStr(aryData(i, 2))) = dicList(3) End If If CStr(aryData(i, 2)) = "" Then Set dicList(1)(CStr(aryData(i, 1))) = aryData(i, 5) Else Set dicList(1)(CStr(aryData(i, 1))) = dicList(2) End If Next CBs(1).List = dicList(1).Keys End Sub '子のDictionaryを取得、存在しなければ新規に生成 Public Sub ListExistsCheck(dicListP As Dictionary, dicListC As Dictionary, key) If dicListP.Exists(CStr(key)) Then Set dicListC = dicListP(CStr(key)) Else Set dicListC = New Dictionary End If End Sub 以上です。 4列目のときと分類の値が""のときはDictionaryのItemに金額を代入するようにしました。 コンボボックスをクリックしたときに、対応するDictionaryのItemが オブジェクト(Dictionary)でなければ金額と判断してテキストボックスに代入してます。 （hatena） 2021/03/08(月) 16:39 ---- 連投ご容赦。 2021/03/08(月) 10:26 の投稿で指摘されたバグの対策と、 コードを少し修正しました。 Option Explicit Dim dicList(1 To 4) As Dictionary '分類リスト格納用連想配列 Dim CBs(1 To 4) As MSForms.ComboBox Private Sub cmdCancel_Click() Unload Me End Sub Private Sub cmdOK_Click() '選択したリストを使った処理 Unload Me End Sub Public Sub SetComboBox(Idx As Long) If dicList(Idx).Exists(CBs(Idx).Text) Then Dim i As Long For i = Idx + 1 To 4 CBs(i).Value = "" Next For i = Idx + 1 To 4 CBs(i).Enabled = False Next If IsObject(dicList(Idx)(CBs(Idx).Text)) Then Set dicList(Idx + 1) = dicList(Idx)(CBs(Idx).Text) CBs(Idx + 1).Enabled = True CBs(Idx + 1).List = dicList(Idx + 1).Keys Me.cmdOK.Enabled = False Me.TextBox1.Value = "" Else Me.cmdOK.Enabled = True Me.TextBox1.Value = dicList(Idx)(CBs(Idx).Text) End If End If End Sub Private Sub ComboBox1_Click() Call SetComboBox(1) End Sub Private Sub ComboBox2_Click() Call SetComboBox(2) End Sub Private Sub ComboBox3_Click() Call SetComboBox(3) End Sub Private Sub ComboBox4_Click() If CBs(4).Text <> "" Then Me.cmdOK.Enabled = True Me.TextBox1.Value = dicList(4)(CBs(4).Text) End If End Sub Private Sub UserForm_Initialize() Set CBs(1) = Me.ComboBox1 Set CBs(2) = Me.ComboBox2 Set CBs(3) = Me.ComboBox3 Set CBs(4) = Me.ComboBox4 CBs(2).Enabled = False CBs(3).Enabled = False CBs(4).Enabled = False Me.cmdOK.Enabled = False Dim aryData() With Worksheets("ListData").Range("A1").CurrentRegion aryData = .Offset(1).Resize(.Rows.Count - 1).Value End With Set dicList(1) = New Dictionary Dim i As Long For i = 1 To UBound(aryData) Call ListExistsCheck(aryData, 1, i) Call ListExistsCheck(aryData, 2, i) Call ListExistsCheck(aryData, 3, i) dicList(4)(CStr(aryData(i, 4))) = aryData(i, 5) Call SetDicList(aryData, 3, i) Call SetDicList(aryData, 2, i) Call SetDicList(aryData, 1, i) Next CBs(1).List = dicList(1).Keys End Sub '子のDictionaryを取得、存在しなければ新規に生成 Public Sub ListExistsCheck(aryData, Idx As Long, rowNum As Long) If dicList(Idx).Exists(CStr(aryData(rowNum, Idx))) Then Set dicList(Idx + 1) = dicList(Idx)(CStr(aryData(rowNum, Idx))) Else Set dicList(Idx + 1) = New Dictionary End If End Sub 'DictionaryのItemにリストを格納、空欄の場合は金額を格納 Public Sub SetDicList(aryData, Idx As Long, rowNum As Long) If CStr(aryData(rowNum, Idx + 1)) = "" Then Set dicList(Idx)(CStr(aryData(rowNum, Idx))) = aryData(rowNum, 5) Else Set dicList(Idx)(CStr(aryData(rowNum, Idx))) = dicList(Idx + 1) End If End Sub （hatena） 2021/03/08(月) 17:30 ---- hatena様 何度もありがとうございます。 ユーザーフォームにテキストボックス「TextBox1」を追加した後、早速実行してみましたが 実行時エラー'424': オブジェクトが必要です。 と表示されてしまいました。 何が原因か分かりますでしょうか? よろしくお願いいたします。 （乾燥肌） 2021/03/08(月) 17:36 ---- 当方のサンプルでは問題なく動作してます。 コードはそのままコピーしてますか。 エラーがでるのはどのコードででますか。 （hatena） 2021/03/08(月) 18:38 ---- hatena様 はい、そのままコピーしています。 ここがエラーというような提示がなく、詳細が分からないのですが、 Private Sub UserForm_Initialize() この1文の「UserForm」という部分を別の名前に変えると何故かフォームは起動しました。 例えば、「UserForm1」でもフォームは起動します。 ただ、マクロが反映されていませんでした。 原因がよくわかりません…。 （乾燥肌） 2021/03/08(月) 20:02 ---- Private Sub UserForm_Initialize() は変えたらダメです。 変えたらユーザーフォームを開いたときに実行されません。 「ListData」という名前のシートに分類リストの表があるのですよね。 うーん、困りましたね。 こちらでは問題なく動作しているので、 ちょっと原因は想像つかないです。 （hatena） 2021/03/08(月) 21:06 ---- dicList(1 To 4) As Dictionary でエラー コンパイルエラー: ユーザー定義型は定義されていません。 （） 2021/03/08(月) 21:35 ---- hatena様 検索してみたら、似たようなエラーが載っていました。 https://okwave.jp/qa/q9608747.html 私はこれをみても対処法が良くわかりませんが、手掛かりになりそうでしょうか…? （）様 私も最初そのようなエラーが出ましたが、 VBE画面の「ツール」→「参照設定」で Microsoft Scripting Runtime を有効にしたら解消しました。 （乾燥肌） 2021/03/08(月) 21:55 ---- 乾燥肌さん、使っているシート名は何ですか。 （bc） 2021/03/08(月) 22:08 ---- あと、エラー発生のダイアログで「デバッグ」ボタンを押すと 黄色く反転した行のあるVBE画面になるはずです。 その黄色く反転したところがエラーの原因てす。 その行の内容について教えてください。 （bc） 2021/03/08(月) 22:13 ---- 茶々入れ失礼します。 VBEの「ツール」 「オプション」 「全般」 「エラートラップ」 で、 「クラスモジュールで中断」を選んで実行すると、 実際のエラー箇所で止まって、黄色くハイライトするはずです。 質問者さんがどこで止まったかを示すと、 解決のヒントになると思いますよ。 （γ） 2021/03/08(月) 22:19 ---- bc様 シート名は ListData です。 γ様 ありがとうございます。 エラー箇所が分かりました。 '子のDictionaryを取得、存在しなければ新規に生成 という所の Set dicList(Idx + 1) = dicList(Idx)(CStr(aryData(rowNum, Idx))) が黄色になっています。 なお、現在 ・Visual Basic For Applications ・Microsoft Excel 15.0 Object Library ・OLE Automation ・Microsoft Office 15.0 Object Library ・Microsoft Forms 2.0 Object Library ・Microsoft Scripting Runtime 上記6つが有効になっています。 よろしくお願いします。 （乾燥肌） 2021/03/08(月) 22:33 ---- 項目 項目 項目 項目 項目 大 中 小 100 大 中 小 小小 100 こんなリストのときにエラーが出ているように思いますが合っていますか? （bc） 2021/03/09(火) 09:02 ---- コードを読み説くと、上記の例はListExistsCheckで Set dicList(Idx)(CStr(aryData(rowNum, Idx))) = aryData(rowNum, 5) と、dicList(Idx)(CStr(aryData(rowNum, Idx)))に値を代入したあとに Set dicList(Idx + 1) = dicList(Idx)(CStr(aryData(rowNum, Idx))) と、Dictionaryオブジェクトをセットしようとしてエラーになっていました。 （bc） 2021/03/09(火) 10:06 ---- bcさん、 なるほど、そこはエラーになりますね。 サンプルのデータは同じ親分類で子分類が空欄のものは後にくるものでした。 ちょっと対策考えてみます。 （hatena） 2021/03/09(火) 13:06 ---- 思ったんですか、 項目 項目 項目 項目 項目 大 中 小 100 大 中 小 小小 100 これってデータ的にどうなんでしょうか。 小小分類まであるということなら、小小分類に空欄はおかしいし、 小分類までなら、小小分類は空欄でないとだめなはずです。 小分類を選択した時点で、小小分類があるかどうか未確定という状態はありえるのでしょうか。 （hatena） 2021/03/09(火) 13:22 ---- 例を挙げると「医科点数表区分番号の設定例」があります。 下例では大項目のみから小小小項目までの記載区分があります。 https://shinryohoshu.mhlw.go.jp/shinryohoshu/file/info/s2code160304.pdf （bc） 2021/03/09(火) 14:04 ---- 上記の疑問は質問者さんへのものです。 そういう事例はあるとは思いますが、 質問者さんの案件ではあるのかどうか、 > 大分類→中分類 で終わるものもあれば、 大分類→中分類→小分類 で終わるものもあれば、 大分類→中分類→小分類→小小分類 で終わるものもあります。 という説明だと、分類を選択した時点で終わるかどうか確定しているとも取れます。 というのも、対策コードが結構面倒そうなので、 手を付ける前に確認しておきたかったのです。 （hatena） 2021/03/09(火) 14:27 ---- すみません。 余計なことでしたね。 （bc） 2021/03/09(火) 14:38 ---- bc様 ありがとうございます。 ＞大 中 小 100 ＞大 中 小 小小 100 まさしく、上記のようになっていました。 私の操作ミスで表の一部が消えていたようです。 「医科点数表区分番号の設定例」 の例を上げていただきましたが、今回の用途ではそのようなデータは存在しません。 hatena様 ありがとうございます。 現在のコードで正しく動作しています。 もし、今後「F列」や「G列」にも現在の「E列」のように、全行データが入った場合、 同様にテキストボックスにそれらを表示させるには、どこを編集すればよいでしょうか? （乾燥肌） 2021/03/09(火) 15:54 ---- テキストボックスが3つありそこに表示させるということでよろしいでしょうか。 最後のDictionaryのアイテムに行番号を格納するようにして、 データ配列 aryData() はモジュールレベルで宣言して、 テキストボックスに代入するときは、行番号を元にaryData()から値を取得するようにしてみました。 Option Explicit Dim dicList(1 To 4) As Dictionary '分類リスト格納用連想配列 Dim CBs(1 To 4) As MSForms.ComboBox Dim aryData() Private Sub cmdCancel_Click() Unload Me End Sub Private Sub cmdOK_Click() '選択したリストを使った処理 Unload Me End Sub Public Sub SetComboBox(Idx As Long) If dicList(Idx).Exists(CBs(Idx).Text) Then Dim i As Long For i = Idx + 1 To 4 CBs(i).Value = "" Next For i = Idx + 1 To 4 CBs(i).Enabled = False Next If IsObject(dicList(Idx)(CBs(Idx).Text)) Then Set dicList(Idx + 1) = dicList(Idx)(CBs(Idx).Text) CBs(Idx + 1).Enabled = True CBs(Idx + 1).List = dicList(Idx + 1).Keys Me.cmdOK.Enabled = False Me.TextBox1.Value = "" Me.TextBox2.Value = "" Me.TextBox3.Value = "" Else Me.cmdOK.Enabled = True Dim r As Long: r = dicList(Idx)(CBs(Idx).Text) Me.TextBox1.Value = aryData(r, 5) Me.TextBox2.Value = aryData(r, 6) Me.TextBox3.Value = aryData(r, 7) End If End If End Sub Private Sub ComboBox1_Click() Call SetComboBox(1) End Sub Private Sub ComboBox2_Click() Call SetComboBox(2) End Sub Private Sub ComboBox3_Click() Call SetComboBox(3) End Sub Private Sub ComboBox4_Click() If CBs(4).Text <> "" Then Me.cmdOK.Enabled = True Dim r As Long: r = dicList(4)(CBs(4).Text) Me.TextBox1.Value = aryData(r, 5) Me.TextBox2.Value = aryData(r, 6) Me.TextBox3.Value = aryData(r, 7) End If End Sub Private Sub UserForm_Initialize() Set CBs(1) = Me.ComboBox1 Set CBs(2) = Me.ComboBox2 Set CBs(3) = Me.ComboBox3 Set CBs(4) = Me.ComboBox4 CBs(2).Enabled = False CBs(3).Enabled = False CBs(4).Enabled = False Me.cmdOK.Enabled = False With Worksheets("ListData").Range("A1").CurrentRegion aryData = .Offset(1).Resize(.Rows.Count - 1).Value End With Set dicList(1) = New Dictionary Dim i As Long For i = 1 To UBound(aryData) Call ListExistsCheck(aryData, 1, i) Call ListExistsCheck(aryData, 2, i) Call ListExistsCheck(aryData, 3, i) dicList(4)(CStr(aryData(i, 4))) = i Call SetDicList(aryData, 3, i) Call SetDicList(aryData, 2, i) Call SetDicList(aryData, 1, i) Next CBs(1).List = dicList(1).Keys End Sub '子のDictionaryを取得、存在しなければ新規に生成 Public Sub ListExistsCheck(aryData, Idx As Long, rowNum As Long) If dicList(Idx).Exists(CStr(aryData(rowNum, Idx))) Then Set dicList(Idx + 1) = dicList(Idx)(CStr(aryData(rowNum, Idx))) Else Set dicList(Idx + 1) = New Dictionary End If End Sub 'DictionaryのItemにリストを格納、空欄の場合は金額を格納 Public Sub SetDicList(aryData, Idx As Long, rowNum As Long) If CStr(aryData(rowNum, Idx + 1)) = "" Then dicList(Idx)(CStr(aryData(rowNum, Idx))) = rowNum Else Set dicList(Idx)(CStr(aryData(rowNum, Idx))) = dicList(Idx + 1) End If End Sub （hatena） 2021/03/09(火) 17:00 ---- hatena様 ありがとうございます。 素晴らしいです。完璧です! この件に携わっていただいた皆様方、本当にありがとうございました。 （乾燥肌） 2021/03/09(火) 19:23... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202103/20210302204123.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97056 documents and 608292 words.
訪問者：