文字列のソート

文字列をバブルソートする

ちょっとやってみた。

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

では、配列の隣同士の要素を比較している。引数isAscendingTrueのときは、昇順ソート。

したがって、

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を返すようにした。

実験

シート上に

f:id:akashi_keirin:20190909074221j:plain

このように文字を入力しておき、選択状態にしておく。

そうしておいて、次のコードで実験。

スト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には昇順に並べ替えた文字列がぶち込まれているはずだ。

実行結果

f:id:akashi_keirin:20190909074225j:plain

このとおり。

おわりに

f:id:akashi_keirin:20190909074229j:plain

NTFS上のフォルダからFileSystemObjectを使って取り出したときと同じ並び順になっている。

比較するときに、「str1」と「str2」を「StrConv(str1, vbHiragana)」と「StrConv(str2, vbHiragana)」にしたら、エクスプローラーと同じ並び順にできるのかな?