今回も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だと半分以下の量で書ける気がする。