文字列のソート
文字列をバブルソートする
ちょっとやってみた。
String型配列をソートして返すFunction
とりあえず、ひととおりコードを晒す。
リスト1 標準モジュール
Public Function getSortedArray( _ ByRef tgtArr() As String, _ Optional ByVal isAscending = True) As String() Dim ret() As String ret = tgtArr Dim i As Long Dim j As Long For i = LBound(ret) To UBound(ret) - 1 'ソート完了していたらループを抜ける……(3)' If hasDone(ret, isAscending) Then Exit For For j = LBound(ret) To UBound(ret) - i - 1 '隣の要素の方が小さい(大きい)なら要素を交換する……(1)' If isAscending Then If isLittle(ret(j), ret(j + 1)) Then _ ret = swap(ret, j, j + 1) Else If isGreater(ret(j), ret(j + 1)) Then _ ret = swap(ret, j, j + 1) End If Next Next getSortedArray = ret End Function Private Function isLittle( _ ByVal str1 As String, _ ByVal str2 As String) As Boolean 'str2の方がstr1よりも小さかったらTrue' If str2 < str1 Then _ isLittle = True Else isLittle = False End Function Private Function isGreater( _ ByVal str1 As String, _ ByVal str2 As String) As Boolean 'str2の方がstr1よりも大木凡人だったらTrue' If str2 > str1 Then _ isGreater = True Else isGreater = False End Function '配列の要素を交換する……(2)' Private Function swap( _ ByRef tgtArr() As String, _ ByVal index1 As Long, index2 As Long) As String() Dim ret() As String ret = tgtArr Dim tmp As String tmp = ret(index1) ret(index1) = ret(index2) ret(index2) = tmp swap = ret End Function 'ソート完了かどうか調べる……(4)' Private Function hasDone( _ ByRef tgtArr() As String, _ Optional ByVal isAscending As Boolean = True) As Boolean hasDone = False Dim i As Long For i = LBound(tgtArr) To UBound(tgtArr) - 1 If isAscending Then If tgtArr(i) > tgtArr(i + 1) Then Exit Function Else If tgtArr(i) < tgtArr(i + 1) Then Exit Function End If Next hasDone = True End Function
比較演算子「<
」、「>
」で文字列の比較ができるので、その機能を利用。
(1)の
If isAscending Then If isLittle(ret(j), ret(j + 1)) Then _ ret = swap(ret, j, j + 1) Else If isGreater(ret(j), ret(j + 1)) Then _ ret = swap(ret, j, j + 1) End If
では、配列の隣同士の要素を比較している。引数isAscending
がTrue
のときは、昇順ソート。
したがって、
If isLittle(ret(j), ret(j + 1))
がTrue
のとき、すなわち右側にある要素の方が小さいときは、(2)のswap
メソッドで順序を入れ換える。
(2)の
Private Function swap( _ ByRef tgtArr() As String, _ ByVal index1 As Long, index2 As Long) As String() Dim ret() As String ret = tgtArr Dim tmp As String tmp = ret(index1) ret(index1) = ret(index2) ret(index2) = tmp swap = ret End Function
では、一時的な変数tmp
を用いた三角トレード方式で、配列の要素を交換している。
単純なバブルソートだと、ソートが完了している状態でもバカ正直に比較作業を繰り返してしまうので、For
ループの先頭に(3)の
If hasDone(ret, isAscending) Then Exit For
を入れて、ソート完了状態ならループを抜けるようにした。
このhasDone
メソッドは、(4)の
Private Function hasDone( _ ByRef tgtArr() As String, _ Optional ByVal isAscending As Boolean = True) As Boolean hasDone = False Dim i As Long For i = LBound(tgtArr) To UBound(tgtArr) - 1 If isAscending Then If tgtArr(i) > tgtArr(i + 1) Then Exit Function Else If tgtArr(i) < tgtArr(i + 1) Then Exit Function End If Next hasDone = True End Function
こいつ。
単純に、左の要素が右の要素よりも大きい(小さい)とわかった瞬間にFalse
を返すようにした。
実験
シート上に
このように文字を入力しておき、選択状態にしておく。
そうしておいて、次のコードで実験。
リスト2 標準モジュール
Private Sub testSortedArray() Dim i As Long Dim ar1() As String ar1 = Split(getJoinedString(Selection), ",") '……(5)' Dim ar2() As String ar2 = getSortedArray(ar1, True) '……(6)' For i = LBound(ar2) To UBound(ar2) Debug.Print ar2(i) Next End Sub Private Function getJoinedString( _ ByVal targetRange As Range) As String Dim ret As String Dim targetCell As Range For Each targetCell In targetRange ret = ret & targetCell.Value & "," Next ret = Left(ret, Len(ret) - 1) getJoinedString = ret End Function
(5)の
ar1 = Split(getJoinedString(Selection), ",")
は、getJoinedString
を呼び出して、セルに入力されている文字列を配列にしただけ。
(6)の
ar2 = getSortedArray(ar1, True)
で、ar2
には昇順に並べ替えた文字列がぶち込まれているはずだ。
実行結果
このとおり。
おわりに
NTFS上のフォルダからFileSystemObjectを使って取り出したときと同じ並び順になっている。
比較するときに、「str1
」と「str2
」を「StrConv(str1, vbHiragana)
」と「StrConv(str2, vbHiragana)
」にしたら、エクスプローラーと同じ並び順にできるのかな?