[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ドロップダウンリストをVBAで』(乾燥肌)
現在、2段階のドロップダウンリストを使用しておりますが、
それでも選択肢が多いです(それぞれ選択肢が50程度)。
既存のドロップダウンリストでは表示数が8個しかなく、
また、マウスホイールで上下移動ができないため不便を感じております。
そのため、VBAで多数の選択肢を表示可能な2段階or3段階のドロップダウンリストを作成したいのですが、
当方、VBAを学び始めて1ヶ月ほどのため、基礎的な処理はある程度できますが、ドロップダウンリストはどのように作れば良いか、全く分からず頓挫しております。
どなたかお助けいただけないでしょうか。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
(推奨) 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
スラッシュをつけるのは表示だけであって、
処理に使用する文字列は、スラッシュを消去したものを使います。
(γ) 2021/03/04(木) 14:48
リストデータの持ち方は、下記のような感じが扱いやすそうです。
大分類 中分類 小分類 小小分類
A a あ ア
A a あ イ
A a い ウ
A b う
A b
重複が出るのでDictionaryで重複排除したリストを作成するようにすればいいでしょう。
Dictionaryのアイテムに次のリストのDictionaryを格納するようにするといいですね。
以前、そのようなものを作成したことがあります。
(hatena) 2021/03/04(木) 16:03
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
ユーザーフォームをつくり
「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
コンパイルエラー:
ユーザー定義型は定義されていません。
と表示されてしまいます。
現在、
・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
Microsoft Scripting Runtime 参照設定だと思います。あとボタンのオブ ジェクト名を合わせると、(hatena)さん 2021/03/06(土) 02:01のコード 当方では動きましたですよ。(#^^#)v 連想配列使いとか、纏め方が素晴らしいですね ( ..)φメモメモ とても勉強になりました←頭のショートが 治まったような気が。。。(◎_◎;)でわでわ m(__)m (隠居じーさん) 2021/03/07(日) 22:37
(乾燥肌) 2021/03/08(月) 09:00
大分類 中分類 小分類 小小分類
A県
B県 1市
B県 2市 a区
B県 2市 b区 ああ
B県 2市 b区 いい
・ ・ ・ ・
・ ・ ・ ・
・ ・ ・ ・
上のようなデータの中から
「B県 2市 b区 いい」
まで選択した後、「A県」に変えた場合、
A県の中分類、小分類、小小分類リストにB県のデータが適応されたままになっています。
これはどのようにすれば対処できますでしょうか?
また、可能であれば、「クリア」というボタンを押すことで
大、中、小、小小の選択状況をリセットしたいです。
何度もお願いしてしまい申し訳ありませんが、よろしくお願いいたします。
(乾燥肌) 2021/03/08(月) 10:26
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
上記のように、いずれのデータも「E列」に料金(数値のみ)が入力されている場合、
例えば、B県 2市 a区をコンボボックスで選択した際に「1,350」と分かるようにしたいのですが、
どのように組めばよいでしょうか?
よろしくお願いいたします。
(乾燥肌) 2021/03/08(月) 15:01
ユーザーフォームにテキストボックス「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
実行時エラー'424':
オブジェクトが必要です。
と表示されてしまいました。
何が原因か分かりますでしょうか?
よろしくお願いいたします。
(乾燥肌) 2021/03/08(月) 17:36
コードはそのままコピーしてますか。
エラーがでるのはどのコードででますか。
(hatena) 2021/03/08(月) 18:38
Private Sub UserForm_Initialize()
この1文の「UserForm」という部分を別の名前に変えると何故かフォームは起動しました。
例えば、「UserForm1」でもフォームは起動します。
ただ、マクロが反映されていませんでした。
原因がよくわかりません…。
(乾燥肌) 2021/03/08(月) 20:02
変えたらユーザーフォームを開いたときに実行されません。
「ListData」という名前のシートに分類リストの表があるのですよね。
うーん、困りましたね。
こちらでは問題なく動作しているので、
ちょっと原因は想像つかないです。
(hatena) 2021/03/08(月) 21:06
https://okwave.jp/qa/q9608747.html
私はこれをみても対処法が良くわかりませんが、手掛かりになりそうでしょうか…?
()様
私も最初そのようなエラーが出ましたが、
VBE画面の「ツール」→「参照設定」で
Microsoft Scripting Runtime
を有効にしたら解消しました。
(乾燥肌) 2021/03/08(月) 21:55
VBEの「ツール」 「オプション」 「全般」 「エラートラップ」 で、
「クラスモジュールで中断」を選んで実行すると、
実際のエラー箇所で止まって、黄色くハイライトするはずです。
質問者さんがどこで止まったかを示すと、
解決のヒントになると思いますよ。
(γ) 2021/03/08(月) 22:19
γ様
ありがとうございます。
エラー箇所が分かりました。
'子の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
こんなリストのときにエラーが出ているように思いますが合っていますか?
(bc) 2021/03/09(火) 09:02
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
(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
hatena様
ありがとうございます。
現在のコードで正しく動作しています。
もし、今後「F列」や「G列」にも現在の「E列」のように、全行データが入った場合、
同様にテキストボックスにそれらを表示させるには、どこを編集すればよいでしょうか?
(乾燥肌) 2021/03/09(火) 15:54
最後の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
この件に携わっていただいた皆様方、本当にありがとうございました。
(乾燥肌) 2021/03/09(火) 19:23
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.