VBA List.Box ソート機能 ユーザ指定

Question

お疲れ様です。
Takkoです。

VBAで現在ツールを作成しているものです。

現在フォーム内には、
List.Boxがあり、決められた名前のファイルが格納されています。
現在、自動ソート？なのかは分かりませんが、名前順になっています。

ListBoxには
例えばこんなファイルがあります。
ABC.test_解析0524.pdf
ABC.test_解析0525.pdf
【ABC】test_log0524.pdf
【ABC】test_log0525.pdf
【ABC】test_sql0524.pdf
【ABC】test_sql0525.pdf

これは現在名前順でソートされていると思いますが、
例えばこれを以下のようにソートしたい場合、どのような処理を施せばよいでしょうか。

【ABC】test_sql0524.pdf
【ABC】test_sql0525.pdf
【ABC】test_log0524.pdf
【ABC】test_log0525.pdf
ABC.test_解析0524.pdf
ABC.test_解析0525.pdf

フォームに新規でソートというボタンを配置し、
上記のソート順に並び替えたいのですが、
名前順ではないし、ListBoxの配列順でもないため、
どのようにソートすればよいか分かりません。

ファイル名を取得することは出来るので、
取得したファイル名に条件付で名前順ソートをすれば可能だと思うのですが、
やり方がいまいちわかりません。

private Sub sortBtn_Click()
 //試験用にListBoxへ格納
 listBox1.AddItem "ABC.test_解析0524.pdf"
 listBox1.AddItem "ABC.test_解析0525.pdf"
 listBox1.AddItem "【ABC】test_log0524.pdf"
 listBox1.AddItem "【ABC】test_log0525.pdf"
 listBox1.AddItem "【ABC】test_sql0524.pdf"
 listBox1.AddItem "【ABC】test_sql0525.pdf"
 //ソート処理
 //全く分からない。listBox1.Sorted?
 
End Sub

一応ロジックで考えると、
ACC.test_解析のグループ
【ABC】test_log0524のグループ
【ABC】test_sql0524のグループ
で三つに切り分けて、
その三つを指定の文字列を含むものから優先に名前順ソートして、
ListBoxに入れなおせばよいのだとは思いますが・・・。

間違っていたらすいません。

アドバイス、お願いします。

Answer 1

書いてみました。
若干面倒な処理ですが、整理して書けば単純なソート処理と大差ありません。
サンプルなので配列で処理してますが、これをリストボックスに置き換えていただければよいです。

Sub test()
    Dim items As Variant
    items = Array( _
        "ABC.test_解析0524.pdf", _
        "ABC.test_解析0525.pdf", _
        "【ABC】test_log0524.pdf", _
        "【ABC】test_log0525.pdf", _
        "【ABC】test_sql0524.pdf", _
        "【ABC】test_sql0525.pdf")

    Dim i As Long
    Dim j As Long
    Dim tmp As Variant
    Dim g1 As Long
    Dim g2 As Long
    Dim c1 As String
    Dim c2 As String
    
    ' ソート処理
    For i = 0 To UBound(items) - 1
        For j = i + 1 To UBound(items)
            ' グループ判定
            g1 = IsGroup(items(i), c1)
            g2 = IsGroup(items(j), c2)
            ' 入れ替え判定
            If (g1 = g2 And c1 > c2) Or _
               (g1 <> g2 And g1 > g2) Then
               ' 入れ替え
                tmp = items(i)
                items(i) = items(j)
                items(j) = tmp
            End If
        Next
    Next
    
    For i = 0 To UBound(items)
        Debug.Print items(i)
    Next
End Sub

' グループ判定し、優先度を表す番号と比較文字列を返却
Function IsGroup(item As Variant, cs As String)
    If InStr(1, item, "【ABC】test_sql") > 0 Then
        IsGroup = 1
        cs = Mid(item, 14)
    ElseIf InStr(1, item, "【ABC】test_log") > 0 Then
        IsGroup = 2
        cs = Mid(item, 14)
    ElseIf InStr(1, item, "ABC.test_解析") > 0 Then
        IsGroup = 3
        cs = Mid(item, 10)
    Else
        IsGroup = 4
        cs = item
    End If
End Function

Comments

[King_of_Flies]

c1 と　c2は何のために宣言されているのでしょうか？

[ttyp03]

IsGroup関数でグループ名以降の文字列を受け取るのに使っています。

[King_of_Flies]

VBAってreturn っていう返却の仕方をしないので、全然わからないのが困ります＾＾；

g1がLongなんでIsGroup()の返却値はLong型が期待されるのだと思いますが、このプログラムだと一回目の実データでは何が帰ってくるのですか?

[ttyp03]

あ・・・、関数の戻り値の型を定義し忘れてました。
正確にはこうですね。
Function IsGroup(item As Variant, cs As String) As Long
戻り値の返し方は慣れるしかないですね。
で、質問の件ですが、
g1＝3, c1=解析0524.pdf
が、返ります。
こういうのはデバッガで見たり、デバッグ文入れればご自分で確認できるので、スキルアップのためにもやってみてください。

[King_of_Flies]

自分なりに解析して、ListBoxで実行する場合のコードを記述してみたのですが、
Private Sub SortBtn_Click()
Dim i As Long
Dim j As Long
Dim g1 As Long
Dim g2 As Long
Dim c1 As String
Dim c2 As String
Dim tmp As Variant

　 'lstConcatの配列の要素数を格納する。
Dim lstConcatCount As Long
lstConcatCount = lstConcat.ListCount

'lstConcatに格納されているアイテムの名前を格納する配列を宣言。
Dim ConcatItemNames As Variant
'配列の要素数を宣言
ReDim ConcatItemNames(lstConcatCount)

For i = 0 To lstConcatCount - 1 Step 1
For j = i + 1 To lstConcatCount
'グループ判定
g1 = IsGroup(lstConcat.List(i), c1)
g2 = IsGroup(lstConcat.List(j), c2)
'入れ替え判定
If (g1 = g2 And c1 > c2) Or (g1 <> g2 And g1 > g2) Then
'入れ替え
tmp = lstConcat(i)
lstConcat(i) = lstConcat(j)
lstConcat(j) = tmp
End If
Next
Next

End Sub

Function IsGroup(item As Variant, cs As String) As Long
If InStr(1, item, "【ABC】test_sql") > 0 Then
IsGroup = 1
cs = Mid(item, 14)
ElseIf InStr(1, item, "【ABC】test_log") > 0 Then
IsGroup = 2
cs = Mid(item, 14)
ElseIf InStr(1, item, "ABC.test_解析") > 0 Then
IsGroup = 3
cs = Mid(item, 10)
Else
IsGroup = 4
cs = item
End If
End Function

IsGroup()の返り値がうまく取得できず、デバックもそこでとまっているので、内部の値が見れない状態です；；

[King_of_Flies]

一応記載すると、IsGroup()のメソッド内部には行っていて、
その時点での引数は
item に lstConcatの一番上に表示されているアイテム名
cs は　””がわたっています。

[King_of_Flies]

あ、少し直したらエラーメッセージが変わりました。
プロパティ配列のインデックスが無効です。
というメッセージですね。
こちらは直せそうです。
Forのiかjの参照がおかしいのだと思います。
すこし見てみます。

[King_of_Flies]

jですね

たぶん最後の要素が1OVERしてるのかな

[King_of_Flies]

For i = 0 To UBound(items) - 1
For j = i + 1 To UBound(items)
' グループ判定
g1 = IsGroup(items(i), c1)
g2 = IsGroup(items(j), c2)
' 入れ替え判定
If (g1 = g2 And c1 > c2) Or _
(g1 <> g2 And g1 > g2) Then
' 入れ替え
tmp = items(i)
items(i) = items(j)
items(j) = tmp
End If
Next
Next
この部分のjのFor Toの最後の箇所に-1が足りないんですかね？

[King_of_Flies]

エラーは出なくなりましたが、
ソートが機能してないでした。。。

[ttyp03]

15:17のコードでソート処理のところを下記のように手直しして動きましたよ。
For i = 0 To lstConcatCount - 2
For j = i + 1 To lstConcatCount - 1
'グループ判定
g1 = IsGroup(lstConcat.List(i), c1)
g2 = IsGroup(lstConcat.List(j), c2)
'入れ替え判定
If (g1 = g2 And c1 > c2) Or (g1 <> g2 And g1 > g2) Then
'入れ替え
tmp = lstConcat.List(i)
lstConcat.List(i) = lstConcat.List(j)
lstConcat.List(j) = tmp
End If
Next
Next

[King_of_Flies]

あ、ちょっと待って下さい。
凡ミスの可能性があるので、暫くお待ちを・・・

[ttyp03]

リストボックスのListCountは個数(6)、一方配列のUBoundは使える添え字の最大(5)なので、それを踏まえてループ回数を調整。
あと入れ替え処理のところでlstConcat(i)となっていたのをlstConcat.List(i)に直しました。

[King_of_Flies]

そうですよね、入れ替え処理のところ、完全に自分の凡ミスです、

ちょっと調整してから出力結果見てみますｗ

[King_of_Flies]

あ、ちなみにIsGroupの判定を増やしたい場合は、
最後のElseの返却するグループを5に変更して、
その前の処理にELSEIF追加って感じで大丈夫ですか？

後追加で、Mid関数の14は15でない理由はありますか？

[King_of_Flies]

出来ました！

[ttyp03]

追加はそんな感じでよいです。
ELSEの値は最初から99とか大きい値にしておいた方が便利かもしれません。
Mid関数に関しては"【ABC】test_log0524.pdf"から"0524.pdf"の部分を取り出したい、なので14文字目からとしています。
15にしてしまうと"524.pdf"になり、月が二桁になったとき対応できませんので。

[King_of_Flies]

本当に、ありがとうございました・・・
感謝してもしきれません。

このソート結構難しかったです・・・

[ttyp03]

無事動いたようでよかったです。

[King_of_Flies]

解決した後に追加で申し訳ないですが一点質問が。

例えば上記コードの場合で、
ABC.test解析だけ降順にしたい場合は、
' 入れ替え判定
If (g1 = g2 And c1 > c2) Or _
(g1 <> g2 And g1 > g2) Then
' 入れ替え
tmp = items(i)
items(i) = items(j)
items(j) = tmp
End If
の入れ替え判定にOrでg1 = 3 And g2 = 3 And c1 < c2を追加すれば可能だと思ったのですが、c1<c2の比較って文字列の昇順降順の比較で合っていますか。？

[King_of_Flies]

c1に"20170525"
c2に"20170524"が入ってきたとして、
この比較のIfの中に入ってしまいます。

[King_of_Flies]

あ、自力解決できました！

[ttyp03]

おはようございます。
返事が遅くなり申し訳ありません。
自力解決できたようでよかったです。

Answer 2

わざわざ、コードを書いているので、コードを書かない方法をEXCEL用で例示します。
（EXCEL君は、表計算ソフトなので、らしい使い方の例、EXCEL以外では別途考慮が必要）
’
１．新規にマクロ有効ブックを作成します。
２．Sheet1!I4:I10 へ、適切なソート対象文字列を記入します。
３．EXCELの開発タブより（開発タブが有効になっていなければ、有効にします。）
４．EXCEL VBA で、ユーザフォームを追加し、リストボックスを追加します。
５．追加したリストボックスの、RowSource ： Sheet1!I4:I10 、ControlSource ： Sheet1!I2 とします。
６．シート上の、Sheet1!I4:I10 へ入力したソート対象文字列を、任意にソートしなおしたり、入れ替えたりして、リストボックスの表示が、どの様に変化するか確認します。
７．コンボボックスも、似たようなものです。

※VB6 では、ControlSourceは、種々データにリンクが可能でしたが、EXCEL VBA では、
シート上のセル、セル群に限定されているようです。
この様な感覚が掴めていると、VBAの他のコントロールや、
VB.NET / C# でも、各コントロールのデータバインドへの応用が可能です。