ｋ－近傍法を模した遊び のその後

先日はｋ－近傍法を模した遊びとして、無作為に作成した任意の点を、最も近くに居る点のグループに属させるということをやってみた。
infoment.hatenablog.com

今日は、その後の話を少しだけ。

先日は、ＡとＢの二つでグループ分けした訳だが、別にもっとたくさんのグループであっても、同じマクロでグループ分けが可能だ。

↓ Ａ～Ｅの５グループの場合。

実行すると、こんな感じになる。

ところがこれ、グループを一つ増やすだけで結構面倒臭い。
↓ これをそのまま散布図にできれば良いのだが、探して探して結局、
方法が分からなかった。

そこでグループ増減のたびに、このような表に置き換えることになる。

また、マーカーの設定も面倒臭い。

きっとうまい方法があるのだろうが、結局分らなかったので諦めて、
シート上にオートシェイプで散布図っぽく描画することにした。

Sub DrawCircle(x As Double, y As Double, group_color As Long)

    Dim Shape As Excel.Shape
    Set Shape = ActiveSheet.Shapes.AddShape(msoShapeOval, x * 3, y * 3, 10, 10)
        
        Shape.Fill.ForeColor.RGB = group_color
        
End Sub
Sub 散布図作成()

    Application.ScreenUpdating = False
    Dim arr As Variant
        ' グループ分けしたテーブル。
        arr = Sheet1.ListObjects(1).DataBodyRange
        
        ' 散布図っぽい描画を行うシート。
        Sheet4.Select
        Sheet4.DrawingObjects.Delete
    
    ' グループ毎の色を覚えておくための連想配列。
    Dim Dict As Scripting.Dictionary
    Set Dict = New Scripting.Dictionary
    Dim GroupColor As Long
        
    Dim i As Long
        For i = 1 To UBound(arr)

            If Dict.Exists(arr(i, 3)) Then
                GroupColor = Dict(arr(i, 3))
            Else
                GroupColor = RGB(WorksheetFunction.RandBetween(0, 255), _
                                 WorksheetFunction.RandBetween(0, 255), _
                                 WorksheetFunction.RandBetween(0, 255))
                Dict(arr(i, 3)) = GroupColor
            End If

            DrawCircle CDbl(arr(i, 1)), CDbl(arr(i, 2)), GroupColor
        Next
    Application.ScreenUpdating = True
    
End Sub

↓ 結果がコチラ。何だか、おどろおどろしいものになってしまった。

まあ、今回はお遊びだったので、これで良しとしよう。

参考まで。