エクセルVBA 独自の並べ替え ComboBoxの表示順を整理

ユーザーフォームのComboboxの表示を思いのままに

家計簿をエクセルVBAで作成しています。
Comboboxを選択して、野菜や肉などの一覧を表示し、買った分を入力するというものです。
今回、煩わしいと思ったのがComboboxの表示順です。
f:id:bimori466:20200408135715p:plain

この表示順序を独自の並び替えにします。
Additemでのべた打ちから、Sheetの一覧から重複しないようにコレクションで取得した品目をComboboxに追加します。

Comboboxの設定

現状

ユーザーフォームのInitializeでAdditemメソッドで追加。
この入力順序が、ユーザーフォームでの表示順となってしまいます。

cmb_入力選択AddItem "野菜"
cmb_入力選択.AddItem "肉"
’省略


独自の並び替えを実施

リストSheetで並び替えをする。その後、Comboboxへ追加。


ポイント
独自の並び替えをするためには、「CustomOrder」で指定する。
例:CustomOrder:="野菜,その他の食品,肉”


並び替え処理のモジュール

Sub List_mySort()

Line = Worksheets("リスト").Cells(Rows.Count, 1).End(xlUp).Row

    Range("A1:B" & Line).Select
    ActiveWorkbook.Worksheets("リスト").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("リスト").Sort.SortFields.Add2 Key:=Range("B1:B" & Line), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal, CustomOrder:="野菜,その他の食品,肉,豆類,赤ちゃん用食品,魚,加工品,乳製品・卵,果物,キノコ・海藻,惣菜,その他,れなっぴ,光熱費,雑費,赤ちゃん用雑費,日用品"
    ActiveWorkbook.Worksheets("リスト").Sort.SortFields.Add2 Key:=Range("A1:A" & Line), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("リスト").Sort
        .SetRange Range("A1:B" & Line)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

並び替えのKey作成部分で、CustomOrderを作成します。
その後、Initialize処理時に重複しないようにコレクションを使って、Comboboxに追加します。


Initialize部のモジュール

Private Sub UserForm_Initialize()

'日付入力
EditForm.txt_日付.Value = Date


'コンボボックスに食品品目選択欄を入れる。

'リストSheetの重複しない項目をコレクションで取得
Dim List As New Collection

Line = Worksheets("リスト").Cells(Rows.Count, 1).End(xlUp).Row

On Error Resume Next

For k_list = 1 To Line
    List.Add Worksheets("リスト").Cells(k_list, 2), Worksheets("リスト").Cells(k_list, 2)
Next

'Combboxに追加
For k = 0 To List.Count
    cmb_入力選択.AddItem List.Item(k)
Next



'金額増減値追加
cmb_金額増減値.AddItem "1"
cmb_金額増減値.AddItem "10"
cmb_金額増減値.AddItem "50"
cmb_金額増減値.AddItem "100"
cmb_金額増減値.AddItem "500"
cmb_金額増減値.AddItem "1000"

'MsgBox Me.Controls.Count


End Sub



Listというコレクションを作成します。
コレクションは重複した値を追加できません。
そのため、On Error Resume Nextで重複時の追加を無視して、追加します。

このようにコードを修正することで、リストに新たな項目に追加があっても、Comboboxベタ打ちのように新規分を追加するコードを書かなくていいということです。

金額はベタ打ちです。