Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Professional : Excel 2010)
複数テキストボックスの内容をソートする
投稿日時: 18/07/10 10:55:29
投稿者: かつのり2

質問よろしくお願いします。
 
ユーザーフォームに複数のテキストボックス(10個)を貼っているのですが、ソートボタンを配置して
テキストボックスの内容をソートしたいと思っているのですが・・・
やはり、テキストボックスの内容を変数に入れてソートするのが良いのでしょうか?
できれば、ワークシートのセルのソートを使わないで行いたいのですが・・・
 
複数のテキストボックスを直接ソートする方法はありますでしょうか?
 
質問よろしくお願いします

回答
投稿日時: 18/07/10 11:05:16
投稿者: WinArrow
投稿者のウェブサイトに移動

>複数のテキストボックスを直接ソートする方法はありますでしょうか?
私が知る限り、無いと思います。
 
変数に入れて
という方法もありますが、
変数を使う場合、
テキストボックスではなく、リストボックスで対応可能ならば、
リストボックスの方がやりやすいと思います。
 
並べ替え項目が複数あるならば、シートを使った方が簡単(しかも早い)です。
 
なぜ
>ワークシートのセルのソートを使わないで
の固執しているのかわかりませんが・・・・
 
作業用シートを見せなくすることもできますので、
シートでの並べ替えをお勧めします。
 
 

投稿日時: 18/07/10 11:48:32
投稿者: かつのり2

返答ありがとうございます。
 
そうですか、複数のテキストボックスのソートというのは出来ませんか・・・
 
ワークシートへ転送してのソート、データベースファイル(.mdb)へ転送してソートなどは、以前 試した事
があって・・・
他にソート方法はないか考えていました。
 
やはり、ワークシートを使ってのソートが簡単で良いですね
ありがとうございました。

回答
投稿日時: 18/07/10 12:38:40
投稿者: mattuwan44

ん。
 
バケットソートですっけ?
それくらいのアルゴリズム、自分で思いつきませんか?
 
比較して入れ替えるを繰り返す=並び替えるでしょ?
 
どれくらいのテキストボックスがあるのか解りませんが、
名前を上手くつけて順番に処理できるようにしてはいかがですか?

投稿日時: 18/07/10 13:43:16
投稿者: かつのり2

返答ありがとうございます
 
バケットソートですか、分かりませんでした。勉強になります
ソートアルゴリズムで検索すると色々なソート方法があるのですね・・
 
もっと勉強します
ありがとうございます

回答
投稿日時: 18/07/10 14:43:48
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
ワークシートへ転送してのソート、データベースファイル(.mdb)へ転送してソートなどは、以前 試した事
があって・・・

 
というコメントがあったので、昔のロジックを思い出して書いてみました。
 
ADODBオブジェうトを使用した並べ替え例です。
データベースは不要です。
 
Private Sub CommandButton1_Click()
Dim myRS As Object, Ctrl As MSForms.Control
 
    Set myRS = CreateObject("ADODB.RecordSet")
    myRS.Fields.Append "TEXTDATA", 200, 200
    myRS.Open
    For Each Ctrl In Me.Corols
        If TypeName(Ctrl) = "TextBox" Then
            myRS.AddNew
            myRS.Fields(0).Value = Ctrl.Text
        End If
    Next
    myRS.Sort = "TEXTDATA"
    myRS.moveFirst
    Do Until myRS.EOF
        Debug.Print myRS.Fields(0)
        myRS.MoveNext
    Loop
    myRS.Close
End Sub

投稿日時: 18/07/10 16:13:33
投稿者: かつのり2

返答ありがとうございます
 
この様な方法もあったのですね・・・
自分にあったコードを書いてテストしてみます
 
勉強になりました。ありがとうございます

回答
投稿日時: 18/07/11 10:03:07
投稿者: WinArrow
投稿者のウェブサイトに移動

確認です。
 
並べかえた結果をテキストボックスに反映する(勿論、元のテキストボックスではない)
ということを考えていますか?
 
その場合、テキストボックスの順序は決まっているんですか?
元のテキストボックスに戻すならば、それほど難しいとは思いませんが、
「元のテキストボックスではない」
のですから、テストボックスの名前の付けた方を工夫しないと、
格納することは難しいと思いますよ!
つまり、
1番目のテキストボックスに
並べかえた1番目の値を格納し、
2番目のテキストボックスに
並べかえた2番目の値を格納し、
・・・・
といった具合です。

回答
投稿日時: 18/07/11 10:52:44
投稿者: hatena
投稿者のウェブサイトに移動

自分は配列をソートする関数を自作して、それを利用してます。
標準モジュールに下記のコードをコピーしておけば、いろいろ使えますので。
 
配列を昇順または降順に並べ替える関数 - hatena chips
https://hatenachips.blog.fc2.com/blog-entry-192.html

Enum arOrder
    arAsc = -1
    arDesc = 0
End Enum
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'引数 MyAry: バリアント配列、動的配列、配列                     ’
'               宣言例 Dim MyArray As Variant                   '
'     Order: arAsc = 昇順, arDesc = 降順 省略可 規定値 昇順     '
'目的      : 配列を昇順に並べ替える                      '
'戻り値    : なし                                               '
'使用例   : ArySort(MyArray)                                '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ArySort(ByRef MyAry, Optional Order As arOrder = arAsc)
    If IsNull(MyAry) Then Exit Sub
     
    If Order Then
        QuickA MyAry, LBound(MyAry), UBound(MyAry)
    Else
        QuickD MyAry, LBound(MyAry), UBound(MyAry)
    End If
End Sub
 
'クイックソート 昇順
Private Sub QuickA(a, L As Long, R As Long)
Dim s, t, i As Long, j As Long
     
    If L < R Then
        s = a((L + R) \ 2)
        i = L - 1: j = R + 1
        Do While 1
            Do
                i = i + 1
            Loop While a(i) < s
            Do
                j = j - 1
            Loop While a(j) > s
            If i >= j Then Exit Do
            t = a(i): a(i) = a(j): a(j) = t
        Loop
         
        QuickA a, L, i - 1
        QuickA a, j + 1, R
    End If
End Sub
 
'クイックソート 降順
Private Sub QuickD(a, L As Long, R As Long)
Dim s, t, i As Long, j As Long
     
    If L < R Then
        s = a((L + R) \ 2)
        i = L - 1: j = R + 1
        Do While 1
            Do
                i = i + 1
            Loop While a(i) > s
            Do
                j = j - 1
            Loop While a(j) < s
            If i >= j Then Exit Do
            t = a(i): a(i) = a(j): a(j) = t
        Loop
         
        QuickD a, L, i - 1
        QuickD a, j + 1, R
    End If
End Sub

 
フォームモジュールでの使用例
Option Explicit

Private Sub TextBoxSort(Optional Order As arOrder = arAsc)
    Dim MyArray(1 To 10) As Variant
    Dim i As Integer

    For i = 1 To 10
        MyArray(i) = Me("TextBox" & i).Value
    Next
    
    ArySort MyArray, Order

    For i = 1 To 10
        Me("TextBox" & i).Value = MyArray(i)
    Next
End Sub

Private Sub CommandButton1_Click()
    '昇順にソート
    TextBoxSort arAsc
End Sub

Private Sub CommandButton2_Click()
    '降順にソート
    TextBoxSort arDesc
End Sub

投稿日時: 18/07/11 16:26:34
投稿者: かつのり2

返事が遅れてすみません
 
合間合間に「ADODBオブジェクト」を試していたのですが、自分の能力が足りなくて・・・まだ、
出来ていません
勉強にもなるので頑張ってみます
 
「テキストボックスを縦に5つ配置してボタンを押すと上から小さい順に並ぶ」と言うのが今回の目標です
 
ワークシートに持って行ってソートして再度テキストボックスに戻せば楽だとは思いますが、色々なコード
を勉強したくて・・・すみません

投稿日時: 18/07/11 16:44:47
投稿者: かつのり2

hatenaさん、返答ありがとう
 
内容、勉強させて頂きます
 
ありがとうございます

回答
投稿日時: 18/07/11 17:32:51
投稿者: WinArrow
投稿者のウェブサイトに移動

ADODBオブジェクトの例
 
前レスで紹介したコードは
「文字列」でフィールド定義しています。
> myRS.Fields.Append "TEXTDATA", 200, 200
2番目の引数は、文字列指定です。
 
数値にする場合は、
    myRS.Fields.Append "TEXTDATA", 3
に変更が必要です。
(4バイト:Integerです)
※データ型を調査して、適切な値に変更してください。
 
数値に修正したコード例です。
テキストボックスの名前は、"TEXT01"〜"TEXTnn"にしています。
 
Private Sub CommandButton1_Click()
 Dim myRS As Object, Ctrl As MSForms.Control
   
     Set myRS = CreateObject("ADODB.RecordSet")
     myRS.Fields.Append "TEXTDATA", 3
     myRS.Open
     For Each Ctrl In Me.Controls
         If TypeName(Ctrl) = "TextBox" Then
             myRS.AddNew
             myRS.Fields(0).Value = CLng(Ctrl.Text)
         End If
     Next
     myRS.Sort = "TEXTDATA"
     myRS.moveFirst
     rx = 0
     Do Until myRS.EOF
         rx = rx + 1
         Me.Controls("TEXT" & Format(rx, "00")).Text = myRS.Fields(0).Value
         myRS.MoveNext
     Loop
     myRS.Close
 End Sub
 

回答
投稿日時: 18/07/12 08:08:25
投稿者: ピンク

>複数のテキストボックスを直接ソートする方法はありますでしょうか?
Private Sub CommandButton1_Click()
    Dim TB(1 To 10) As Control
    Dim i As Long, j As Long
    Dim tmp As String
     
    For i = 1 To 10
        Set TB(i) = Me.Controls("TextBox" & i)
    Next i
    For i = 1 To 10
        For j = 10 To i Step -1
            If TB(i).Text > TB(j).Text Then
                tmp = TB(i).Text
                TB(i).Text = TB(j).Text
                TB(j).Text = tmp
            End If
        Next j
    Next i
End Sub

回答
投稿日時: 18/07/12 09:19:51
投稿者: WinArrow
投稿者のウェブサイトに移動

質問者さんへ
 
ユーザーフォームのテキストボックスの
Textプロパティでも、Valueプロパティでも
データ型は、文字列です。
 
従って、TextAlignに「3」を指定して、「数値」のように見えていても
文字列です。
数値として、並べ替えしたいのでしたら、数値化する必要があります。
 
幾つかの回答をそのまま実行しても、意図する結果にならない可能性があります。
説明不足の部分は、あなたがカスタマイズしましょう。

投稿日時: 18/07/12 11:15:32
投稿者: かつのり2

WinArrow様、mattuwan44様、hatena様、ピンク様
回答ありがとうございました
 
色々なソートコードがあり、これから習得して行きたいと思います
ここの考え方は、Excel VBAだけでなく別言語でも生かせる物だと思っています
 
もっと他の考え方があるのかと思うと心残りですが、この辺で「解決」とさせて
いただきます。
他の初心者の方にも勉強にあると思います
 
ありがとうございました。