ソートの確認をしてみました。

バブルソートを基本から学び，わたしなりに解決をしたので，実務に使えそうだと安心をしているんですが，

感覚的になんか入れ替わる，というのをきちんと確認しようと思い，今日はその動作を見ていました。

Option Explicit

Sub a()
    Range("a1:k100").Clear
    Range("a1:g2").Value = Range("n1:t2").Value
    Dim i, j, k, l
    
    k = 1
    For i = 1 To 6
        For j = 6 To i Step -1
            Range("i1:i2").Value = ""
            If Cells(2, i + 1) < Cells(2, j + 1) Then
                For l = 1 To 2
                    Cells(l, 9) = Cells(l, i + 1)
                    Cells(l, i + 1) = Cells(l, j + 1)
                    Cells(l, j + 1) = Cells(l, 9)
                Next
            End If
            Cells(1, 10).Value = k
            Range("a1:k2").Offset(k * 3 + 2).Value = Range("a1:k2").Value
            Cells(k * 3 + 4, i + 1).Interior.ColorIndex = 3
            Cells(k * 3 + 4, j + 1).Interior.ColorIndex = 4
            If Cells(k * 3 + 3, 9) <> "" Then
                Cells(k * 3 + 3, 9).Resize(2, 1).Interior.ColorIndex = 6
                Cells(k * 3 + 3, i + 1).Interior.ColorIndex = 6
                Cells(k * 3 + 3, j + 1).Interior.ColorIndex = 6
            End If
            k = k + 1
        Next
    Next
                
Range("a1:g2").Value = Range("n1:t2").Value
                
End Sub

確認だけのためなので，いろいろと手を抜いて書いています。

各ステップを書き出させてみると，

変化があった部分を中心に抜き出すと

こんな感じで，IDが早いものが早く引き抜かれて，末尾側に移動するために，入れ替わる現象が起きている。

キーの優劣がつかない部分で入れ替わりが起こることを確認できた。

こういうことも途中を書き出させてみると，地味に楽しいなぁ。

前回おちついたのは　こちら。

Option Explicit

Sub a()
    Range("a1:k100").Clear
    Range("a1:g2").Value = Range("n1:t2").Value
    Dim i, j, k, l
    
    k = 1
    For i = 1 To 6 - 1
        For j = 1 + 1 To 6 - i + 1
            Range("i1:i2").Value = ""
            If Cells(2, j) < Cells(2, j + 1) Then
                For l = 1 To 2
                    Cells(l, 9) = Cells(l, j)
                    Cells(l, j) = Cells(l, j + 1)
                    Cells(l, j + 1) = Cells(l, 9)
                Next
            End If
            Cells(1, 10).Value = k
            Range("a1:k2").Offset(k * 3 + 2).Value = Range("a1:k2").Value
            Cells(k * 3 + 4, j).Interior.ColorIndex = 3
            Cells(k * 3 + 4, j + 1).Interior.ColorIndex = 4
            If Cells(k * 3 + 3, 9) <> "" Then
                Cells(k * 3 + 3, 9).Resize(2, 1).Interior.ColorIndex = 6
                Cells(k * 3 + 3, j).Interior.ColorIndex = 6
                Cells(k * 3 + 3, j + 1).Interior.ColorIndex = 6
            End If
            k = k + 1
        Next
    Next
                
Range("a1:g2").Value = Range("n1:t2").Value
                
End Sub