質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.50%

  • VBA

    2296questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1921questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

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

解決済

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 2,802

King_of_Flies

score 299

お疲れ様です。
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に入れなおせばよいのだとは思いますが・・・。

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

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

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

checkベストアンサー

0

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

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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/05/25 14:38

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

    キャンセル

  • 2017/05/25 14:40

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

    キャンセル

  • 2017/05/25 14:44

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

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

    キャンセル

  • 2017/05/25 14:48

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

    キャンセル

  • 2017/05/25 15:17

    自分なりに解析して、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()の返り値がうまく取得できず、デバックもそこでとまっているので、内部の値が見れない状態です;;

    キャンセル

  • 2017/05/25 15:19

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

    キャンセル

  • 2017/05/25 15:21

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

    キャンセル

  • 2017/05/25 15:22

    jですね

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

    キャンセル

  • 2017/05/25 15:23

    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が足りないんですかね?

    キャンセル

  • 2017/05/25 15:24

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

    キャンセル

  • 2017/05/25 15:29

    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

    キャンセル

  • 2017/05/25 15:30

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

    キャンセル

  • 2017/05/25 15:32

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

    キャンセル

  • 2017/05/25 15:35

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

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

    キャンセル

  • 2017/05/25 15:41

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

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

    キャンセル

  • 2017/05/25 15:46

    出来ました!

    キャンセル

  • 2017/05/25 15:46

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

    キャンセル

  • 2017/05/25 15:47

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

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

    キャンセル

  • 2017/05/25 15:49

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

    キャンセル

  • 2017/05/25 17:31

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

    例えば上記コードの場合で、
    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の比較って文字列の昇順降順の比較で合っていますか。?

    キャンセル

  • 2017/05/25 17:48

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

    キャンセル

  • 2017/05/25 18:04

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

    キャンセル

  • 2017/05/26 08:35

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

    キャンセル

0

わざわざ、コードを書いているので、コードを書かない方法をEXCEL用で例示します。
(EXCEL君は、表計算ソフトなので、らしい使い方の例、EXCEL以外では別途考慮が必要)

1.新規にマクロ有効ブックを作成します。
2.Sheet1!I4:I10 へ、適切なソート対象文字列を記入します。
3.EXCELの開発タブより(開発タブが有効になっていなければ、有効にします。)
4.EXCEL VBA で、ユーザフォームを追加し、リストボックスを追加します。
5.追加したリストボックスの、RowSource : Sheet1!I4:I10 、ControlSource : Sheet1!I2 とします。
6.シート上の、Sheet1!I4:I10 へ入力したソート対象文字列を、任意にソートしなおしたり、入れ替えたりして、リストボックスの表示が、どの様に変化するか確認します。
7.コンボボックスも、似たようなものです。

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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

同じタグがついた質問を見る

  • VBA

    2296questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1921questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。