バブルソートについて理解を進める。
バブルソートへの理解がちゃんとできていないので,(;´▽`A``わたしはここからです。
① ② ③ ④
3 1 4 2
4つの数字をバブルソートで並べる。昇順で考える。
最初に④の数字を決める。 ①と②比較 ②と③比較 ③と④比較と順番に進めて ④が確定 この場合は4が押し出される。
次は,③の数字を決める。 ①と②比較 ②と③比較 ③が確定 この場合は3が押し出される。
次は,②の数字を決める。 ①と②比較 ①も②も確定して終了 ①は1,②は2か。
ふむふむ
4つの数字について決めるのに3段階 Col.Count の数の順を決めるには, 外側のループは文字はiとして Col.Count-1 回でいいということか。
For i=1 to Col.Count-1 ~ Next でよさそうだ
中身のループは,常に①と②の比較からはじめ,その時の残っている要素数-1回で済むようだ。 隣り合っている数字を比べればいいようだ。
つまり,比較する対象は jで扱うとすると jとj+1を比較していく。
1つずつ要素は決まっていき,その分減っていくから,内側のループは Col.Count - i回と言えそうだ。
つまり,内側のループは
for j=1 to Col.Count-i ~ Next かな。
まとめると
For i=1 to Col.Count-1 For j=1 to Col.Count-i 要素jと要素j+1を比較して,逆ならSwap Next Next
こんな感じでいいとわたしは解釈してみた。
それに合わせて,前回までのものを書き直してみる
Option Explicit Function GetDataAsCollection() As Collection Dim Arr: Arr = GetDataAsArray Dim Col As Collection: Set Col = New Collection Dim i, j, k For i = LBound(Arr, 1) + 1 To UBound(Arr, 1) With New person For j = 1 To 列数 .LetParameter j, Arr(i, j) Next Col.Add .Self End With Next Set GetDataAsCollection = Col End Function Function GetDataAsArray() As Variant GetDataAsArray = ThisWorkbook.Worksheets("データ").Range("a1").CurrentRegion.value End Function Sub CollectionSwap(Col As Collection, Index1 As Long, Index2 As Long) Dim Item1 As Variant, Item2 As Variant Set Item1 = Col.Item(Index1) Set Item2 = Col.Item(Index2) Col.Add Item1, after:=Index2 Col.Remove Index2 Col.Add Item2, after:=Index1 Col.Remove Index1 End Sub Function Report(Col As Collection) As Variant Dim p As person, Rangearray() Dim i As Long, n As Long: n = 1 ReDim Rangearray(1 To Col.Count, 1 To 列数) For Each p In Col For i = 1 To 列数 Rangearray(n, i) = p.GetParameter(i) Next n = n + 1 Next Report = Rangearray End Function Sub メイン処理() Dim Col As Collection: Set Col = GetDataAsCollection 'CSort Col, c.カテゴリ, False '第3のキー CSort Col, c.数値1, False, c.数値2, False 'ソート結果出力 ThisWorkbook.Worksheets("出力").Range("a1").Resize(1, 列数).value = ThisWorkbook.Worksheets("データ").Range("a1").Resize(1, 列数).value ThisWorkbook.Worksheets("出力").Range("a2").Resize(Col.Count, 列数) = Report(Col) End Sub Sub CSort(Col As Collection, Key1 As String, Key1昇順 As Boolean, Optional Key2 As String, Optional Key2昇順 As Boolean) Dim p1 As person, p2 As person Dim p1k1 As Variant, p2k1 As Variant, p1k2 As Variant, p2k2 As Variant 'バブルソート Dim i As Long, j As Long For i = 1 To Col.Count - 1 For j = 1 To Col.Count - i Set p1 = Col(j) Set p2 = Col(j + 1) If IsNumeric(Key1) Then p1k1 = CallByName(p1, "GetParameter", VbMethod, Key1) p2k1 = CallByName(p2, "GetParameter", VbMethod, Key1) Else p1k1 = CallByName(p1, Key1, VbGet) p2k1 = CallByName(p2, Key1, VbGet) End If If Key2 <> "" Then If IsNumeric(Key2) Then p1k2 = CallByName(p1, "GetParameter", VbMethod, Key2) p2k2 = CallByName(p2, "GetParameter", VbMethod, Key2) Else p1k2 = CallByName(p1, Key2, VbGet) p2k2 = CallByName(p2, Key2, VbGet) End If End If Dim flag As Boolean: flag = False If Key2 = "" Then If IsGreater(Key1昇順, p1k1, p2k1) Then flag = Not flag Else If IsGreater(Key1昇順, p1k1, p2k1) Then flag = Not flag ElseIf p1k1 = p2k1 Then If IsGreater(Key2昇順, p1k2, p2k2) Then flag = Not flag End If End If End If If flag Then CollectionSwap Col, j, j + 1 Next j Next i End Sub Function IsGreater(which, A, B) As Boolean Select Case which Case True: IsGreater = A > B Case False: IsGreater = A < B End Select End Function
数度試したけど,今のところ問題視していた入れ替わりは起こってはいなさそうだ。
本当かなぁ。
引き続き検証中。。
第3のキー 今はコメントアウトしているけど,それを先に回していたらたしかに,動いていた。
たくさんキーが使えるソートになってるのかなぁ。
くどいけど検証中(;´▽`A``