VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板

　　　　　サンプル投稿用掲示板　　 VB2005 ～用トップページ　　 VB6.0 用トップページ

ソート色々(VB6.0) ( No.0 ) 　[親スレッドへ]

日時： 2009/12/27 15:37
名前： 花ちゃん: ***********************************************************************************
* カテゴリー：[文字列処理][アルゴリズム][]              　　                     *
* キーワード：アルゴリズム,並べ替える,小さい順（昇順）,大きい順（降順）,並び替え　*
***********************************************************************************

【開設当初の掲示板に投稿頂いていた分です】

--------------------------------------------------------------------------
ソート：バブルソート　　投稿者：ゆう（U） [1998/09/14(月)15：24分]
--------------------------------------------------------------------------

前回のバブルソートですがちょっとしたバグが有りました。
（配列の添字が負の数を使用されていると正しい結果を返しません）

と言う訳で添字に負を指定されていても問題なく動作するものをUPします。

'バブルソート(Long版)
'Sorted(省略可能) = True ：昇順（デフォルト）
'         　　　　  False：降順
Public Sub sBubleSort(ByRef myArray() As Long, _
                      Optional Sorted As Boolean = True)
  Dim i As Long
  Dim j As Long
  Dim k As Long
  Dim intMyPointer As Integer
  Dim lngLow As Long, lngHigh As Long

  lngLow = LBound(myArray)
  lngHigh = UBound(myArray)
  intMyPointer = Screen.MousePointer
  Screen.MousePointer = vbHourglass

  Select Case Sorted
    Case True '昇順
      For i = lngHigh To lngLow Step -1
        For j = lngLow + 1 To i
          k = j - 1
          If myArray(k) > myArray(j) Then
            myArray(j) = myArray(j) Xor myArray(k)
            myArray(k) = myArray(j) Xor myArray(k)
            myArray(j) = myArray(j) Xor myArray(k)
          End If
        Next j
      Next i
    Case Else '降順
      For i = lngHigh To lngLow Step -1
        For j = lngLow + 1 To i
          k = j - 1
          If myArray(k) < myArray(j) Then
            myArray(j) = myArray(j) Xor myArray(k)
            myArray(k) = myArray(j) Xor myArray(k)
            myArray(j) = myArray(j) Xor myArray(k)
          End If
        Next j
      Next i
  End Select
  Screen.MousePointer = intMyPointer
End Sub