C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

配列内の値を連番毎にグループ分けする

今回もCATIA V5と言うよりVBAです。
何れは、前回のこちらと組み合わせて使う予定です。
配列内の重複除去した配列と重複していた値の配列の取得 - C#ATIA

具体的には、こんな感じの配列が有るとします。

(1, 2, 3, 5, 6, 9, 10, 13)

条件としては、
・ソートされている
・重複値無し(あっても良いけど・・・)

この配列を

(1, 2, 3)
(5, 6)
( 9, 10)
(13)

の様な状態にグループ分けしたいです。
”世の中、似たような事を考えている人が居るんじゃないのかな?”
と検索してみましたが、見つけることが出来ませんでした。
残念、じゃ作りましょう。

但し、欠番を確認したい気持ちで行う為、

(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15・・・)

と出力されても邪魔なだけの為、最初の配列であれば

1 - 3
5 - 6
9 - 10
13

と結果が分かれば、十分なのでこれをゴールとしたものを
作ってみました。

' vba 連番をグループ化

Option Explicit

Sub CATMain()
    
    Dim ary As Variant
    ary = Array(1, 2, 3, 5, 6, 9, 10, 13)

    Dim dict_groups As Object
    Set dict_groups = group_by_consecutive_numbers(ary)

    Debug.Print get_result_txt(get_values(dict_groups))

End Sub


Private Function group_by_consecutive_numbers( _
    ByVal ary As Variant) _
    As Object
    
    Dim size As Long
    size = UBound(ary) + 1
    ReDim Preserve ary(size)
    ary(size) = -1
    
    Dim dict_groups As Object
    Set dict_groups = CreateObject("Scripting.Dictionary")

    Dim count_groups As Long
    count_groups = 0

    Dim startIdx As Long
    startIdx = 0

    Dim finishNumber As Long
    finishNumber = UBound(ary) - 1

    Dim i As Long
    For i = 0 To finishNumber
        If ary(i) + 1 <> ary(i + 1) Then
            Call dict_groups.Add( _
                count_groups, _
                get_range_ary(ary, startIdx, i) _
            )
            
            startIdx = i + 1
            count_groups = count_groups + 1
        End If
    Next
    
    Set group_by_consecutive_numbers = dict_groups
    
End Function


Private Function get_range_ary( _
    ByVal ary As Variant, _
    ByVal startIdx As Long, _
    ByVal endIdx As Long) _
    As Variant

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = startIdx To endIdx
        dict.Add ary(i), 0
    Next
    
    get_range_ary = dict.keys()

End Function


Private Function get_values( _
    ByVal dict As Object) _
    As Variant

    Dim ary() As Variant
    ReDim ary(UBound(dict.keys()))

    Dim key As Variant
    Dim count As Long
    count = 0
    For Each key In dict.keys()
        ary(count) = dict(key)
        count = count + 1
    Next
    
    get_values = ary

End Function


Private Function get_result_txt( _
    ByVal ary_groups As Variant) _
    As String

    Dim msg As String

    Dim i As Long
    Dim ary As Variant, count As Long
    For i = 0 To UBound(ary_groups)
        ary = ary_groups(i)
        count = UBound(ary)
        Select Case count
            Case 0
                msg = msg & ary(0) & vbCrLf
            Case Is > 0
                msg = msg & _
                    ary(0) & " - " & _
                    ary(count) & vbCrLf
        End Select
    Next
    
    get_result_txt = msg

End Function

思ったより長い・・・。

pythonだと半分以下の量で書ける気がする。