今回も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・・・)
と出力されても邪魔なだけの為、最初の配列であれば
- 3
- 6
- 10
と結果が分かれば、十分なのでこれをゴールとしたものを
作ってみました。
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だと半分以下の量で書ける気がする。