読者です 読者をやめる 読者になる 読者になる

Powerpoint VBAを使おう!

Powerpoint VBAやExcelのVBAで遊んでいます。Word VBAも始めました。

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

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

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

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

確認だけのためなので,いろいろと手を抜いて書いています。
f:id:chemiphys:20170113184314p:plain

各ステップを書き出させてみると,
f:id:chemiphys:20170113184552p:plain
f:id:chemiphys:20170113184812p:plain

変化があった部分を中心に抜き出すと
f:id:chemiphys:20170113185132p:plain
こんな感じで,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

f:id:chemiphys:20170113194154p:plain