コンボボックスの中身を任意順で並べ替え VBA

質問

いつも大変お世話になっております。
Excel2003を使用しております。

ユーザーフォームに置いてある
コンボボックスのデータの順番が毎回変わるのですが、
指定順に並び替えたいです。

例えば、
東京
大阪
北海道
青森
沖縄
仙台
福岡
という順番でコンボボックスに入っている場合、

北海道
青森
仙台
東京
大阪
福岡
沖縄
という順番に自動で並べ替えたいのです。
項目は必ず全てあるわけではなく、

東京
北海道

だけの場合もあります。(コンボボックスの最後には必ず空白が1行あります）

Sub ComboboxNarabi()
Dim i As Long
Dim j As Long
Dim Count As Long
Dim Swap As String
Dim SortListData As Variant

SortListData = Array("北海道", "青森", "仙台", "東京", "大阪", "福岡", "沖縄", "")

Count = 0
For j = 0 To UBound(SortListData)
For i = 0 To ComboBox2.ListCount - 1
If ComboBox2.List(i) = SortListData(j) Then
Swap = ComboBox2.List(Count) '現在の位置の内容をSwapにコピー
ComboBox2.List(Count) = ComboBox2.List(i) '現在位置に、検索したワードをコピー
ComboBox2.List(i) = Swap 'もとの内容をコピー
Count = Count + 1
End If
Next
Next
End Sub

なんだか遠回りしているような気もします。
もう少し、良い方法はありますでしょうか？
以上、よろしくお願い致します！

回答No.1

cj_mover · ベストアンサー

こんにちは。

十分シンプルに纏っていますし、問題なく作動しますから、
そのままでもいいようにも思いますが。
一方で、何度も何度も忙しくリストの内容を書き換えるループが気になる、
ということであれば、理解、共感できる部分ではあります。
参考として、３例挙げてみます。
ここには書きませんが私個人の実務としては
今回のような複雑なソートの場合はADODBでSQLやRecordSet.Sort等を用いることが比較的多かったり、
ソートオーダーが可変な場合などではCollectionやDictionary等のオブジェクトを
配列ソートアルゴリズム等と組み合わせたり、とかもします。
より簡単に書けるものは簡単に済ませるようにも心がけていますけれども、、、。
書換えを考える時には、書換える意図を明確にしておくようにして、
一定の方向性を常に意識しながら書く様にするといいです。
今回は、複雑な処理は避けなるべく簡素に、実行プロシージャの編集が容易なもの、
という意図で３案挙げてみました。
メンテナンスに自信が持てる書き方を選ぶ、というのも、とても大切なことですので。

＃余談。蛇足。
IF Then ステートメントには色々あります。
　　If 条件 Then 真の処理 Else 偽の処理
のように１行で書くことだって出来るのですけれど、
これはまぁ、やり過ぎ、というか非常に読み難いので使いませんが、
　　If 条件 Then Exit Sub
のような排他処理の書き方は、VBAでは定番です。
　　If 条件 Then
　　　　１ページに収まらない程の長ったらしい処理
　　End If
のように書くとEnd Ifの由来を確認するのも面倒ですし、、、。
無論、サブルーチン化するなどの検討も必要ですが、
目にすることの多い例として、特にイベントプロシージャなどでは、
Exit Sub（1行で記す If ... Then ... ステートメント）の使いこなしは重要な基本です。

＃余談２。
VBEコードペイン上のインデントを投稿に反映させる方法ですが、
私は投稿文をメモ帳で書いてから全文をコピペして投稿する習慣がある（自分に課している）ので、
メモ帳にて、半角スペース４つを全角スペース２つに全置換しておくことで、
インデント擬きを表示させています。
昔はコードに全角スペースなど言語道断と仰る方多かったですが、
現行のExcel環境では、全角スペース２つをVBEコードペイン上にコピペすれば、
正しくインデント（タブ、というより半角スペース４つ）に置換してくれるようにもなっています。

以下３例。

' ' 〓〓〓〓〓〓〓〓〓〓
Option Explicit

Private arrSortOrder　'　！　モジュールで宣言。
' ' ↑　FnSortOrder用。頻繁に並べ替えをするならソートオーダーは固定した方が有利。

' ' ＝＝＝＝＝＝＝＝　１◆ベーシック版
' ' ＃せめて記述上だけでも。同じ事を繰り返さない（参照や取得は１回に纏める）ようにしてみる、とか。
Sub Re8668860b() ' ▼実行proc
Dim i As Long
Dim j As Long
Dim Count As Long
Dim Temp As String
Dim Swap As String
Dim SortListData As Variant

　　SortListData = Array("北海道", "青森", "仙台", "東京", "大阪", "福岡", "沖縄", "")
　　With ComboBox2
　　　　Count = 0
　　　　For j = 0 To UBound(SortListData)
　　　　　　For i = 0 To .ListCount - 1
　　　　　　　　Temp = .List(i)
　　　　　　　　If Temp = SortListData(j) Then
　　　　　　　　　　Swap = .List(Count) '現在の位置の内容をSwapにコピー
　　　　　　　　　　.List(Count) = Temp '現在位置に、検索したワードをコピー
　　　　　　　　　　.List(i) = Swap 'もとの内容をコピー
　　　　　　　　　　Count = Count + 1
　　　　　　　　End If
　　　　　　Next
　　　　Next
　　End With
End Sub

' ' ＝＝＝＝＝＝＝＝　２◆配列操作List設定版（並べ替えは関数（配列変数））で
' ' ＃コンボボックスのリスト書換えを１回に纏める、とか。
Sub Re8668860c() ' ▼実行proc）
　　With ComboBox2
　　　　.List = FnSortOrder(.List)
　　End With
End Sub
Function FnSortOrder(ByVal arrCurList As Variant) As Variant
Dim sBuf As String
Dim nUBO As Long
Dim nUBC As Long
Dim nRank As Long
Dim i As Long
Dim j As Long
　　If Not IsArray(arrSortOrder) Then
　　　　arrSortOrder = Array("北海道", "青森", "仙台", "東京", "大阪", "福岡", "沖縄", "")
　　End If
　　arrCurList = ComboBox2.List　'　！　二次元配列
　　For j = 0 To UBound(arrSortOrder)
　　　　For i = 0 To UBound(arrCurList)
　　　　　　If arrCurList(i, 0) = arrSortOrder(j) Then
　　　　　　　　sBuf = arrCurList(nRank, 0)
　　　　　　　　arrCurList(nRank, 0) = arrCurList(i, 0)
　　　　　　　　arrCurList(i, 0) = sBuf
　　　　　　　　nRank = nRank + 1
　　　　　　End If
　　　　Next
　　Next
　　FnSortOrder = arrCurList
End Function

' ' ＝＝＝＝＝＝＝＝　３◆Excelのユーザー設定と作業シート（非表示）を事前に用意しておいて
' ' ＃Excelの並べ替え機能を活用し、実行側では何も考えないで済むようにする、とか。
Private Sub 初期設定()
Dim shSelected As Sheets
　　Set shSelected = ActiveWindow.SelectedSheets
　　With Worksheets.Add
　　　　.Name = "Work"
　　　　.Visible = xlSheetHidden
　　End With
　　shSelected.Select
　　Application.AddCustomList Array("北海道", "青森", "仙台", "東京", "大阪", "福岡", "沖縄", "")
End Sub　'　↑　実行は事前に、一度だけ。
Sub Re8668860e() ' ▼実行proc
　　With ComboBox2
　　　　.List = FnSortCustom(.List)
　　End With
End Sub
Function FnSortCustom(ByVal arrCurList As Variant) As Variant
　　With Sheets("work").Columns(1)
　　　　.Value = Empty　'　.ClearContents
　　　　With .Resize(UBound(arrCurList) + 1)
　　　　　　.Value = arrCurList
　　　　　　.Sort Key1:=.Cells(1), Order1:=xlAscending, _
　　　　　　　　Header:=xlNo, OrderCustom:=Application.CustomListCount + 1, _
　　　　　　　　MatchCase:=True, Orientation:=xlTopToBottom, _
　　　　　　　　SortMethod:=xlStroke, DataOption1:=xlSortNormal
　　　　　　FnSortCustom = .Value
　　　　End With
　　End With
End Function
' ' ＝＝＝＝＝＝＝＝
' ' 〓〓〓〓〓〓〓〓〓〓

お礼

回答ありがとうございます。
タブを入れたつもりが、入っていませんでした！
見づらいプログラムで申し訳ありませんでした。

おぉお、すごいです！
同じことをやるのに3パターンも考えられるなんて…
2次元配列って難しいですね！
プログラムを読むだけで精一杯です（苦笑

元々ある、Excelの並び替え機能が使えるとは思っていませんでした！
確かに、その方法なら今後も…使えそうな気がします！

If文の横にExit Sub　などが基本ですか。
全然使っておりませんでしたorz
その横にEnd If　をつける…のも良いのでしょうか？

中々、プログラムというのは奥が深いですね…！

ありがとうございました＾＾
大変参考になりました！