そこFor Eachじゃなくて MoveNextでしょ

今の言語は必ずIterator(For Each)があってとても簡単にループが作成できて便利なのだが、For Each を使って集計処理をすると以下のようなロジックになる場合が多い。

For Each を使用した集計処理

    Dim col As Collection
    Dim v As Variant
    Dim strWork As String
    Dim lngCnt As Long
    
    Set col = New Collection
    
    col.Add "あ"
    col.Add "い"
    col.Add "い"
    col.Add "う"
    col.Add "え"
    col.Add "え"
    col.Add "お"
    col.Add "お"

    strWork = ""
    lngCnt = 0
    
    For Each v In col
    
        If v <> strWork Then
            
            '初回
            If strWork <> "" Then
                Debug.Print strWork & lngCnt
            End If
        
            strWork = v
            lngCnt = 0
        
        End If
        
        lngCnt = lngCnt + 1
    
    Next

    '集計結果を表示する前にループを抜けてしまう。
    If v <> strWork Then
        Debug.Print strWork & lngCnt
    End If

結果

あ1
い2
う1
え2
お2

結果はもちろん合ってはいるのだけれど、初期化を行う場所や結果を表示する場所が２重になってしまっている。こんなことやっているとちょっと格好が悪い。昔(CobolやVBの時代)はこんなことはなかったはずだが、Iteratorを使うとこうなってしまうのは仕方がないなとは思う。
かといって、コレクションをカーソル風に読むのはわりと面倒。というわけで、コレクションを カーソル風に読むクラスを作成してみた。

カーソル風コレクション読み込みクラス

'------------------------------------------------------
' カーソル風コレクション読み込みクラス
'------------------------------------------------------
Option Explicit

Private mCol As Collection
Private mIndex As Long
Private Sub Class_Initialize()
    mIndex = 0
End Sub
Private Sub Class_Terminate()
    Set mCol = Nothing
End Sub
'------------------------------------------------------
' コンストラクタ
'------------------------------------------------------
Public Sub Init(col As Collection)
 
    Set mCol = col
    Me.MoveFirst
    
End Sub
'------------------------------------------------------
' 終了判定 
'------------------------------------------------------
Property Get Eof() As Boolean

    If mCol Is Nothing Then
        Eof = True
        Exit Sub
    End If
    Eof = mCol.Count < mIndex

End Property
'------------------------------------------------------
' 最初の行に移動
'------------------------------------------------------
Public Sub MoveFirst()
    mIndex = 1
End Sub
'------------------------------------------------------
' 次行取得
'------------------------------------------------------
Public Sub MoveNext()
    mIndex = mIndex + 1
End Sub
'------------------------------------------------------
' セル取得
'------------------------------------------------------
Public Property Get item() As Variant

    If Me.Eof Then
        'EOF後は最後の値を返す
        If IsObject(mCol(mCol.Count)) Then
            Set item = mCol(mCol.Count)
        Else
            item = mCol(mCol.Count)
        End If
    Else
        If IsObject(mCol(mIndex)) Then
            Set item = mCol(mIndex)
        Else
            item = mCol(mIndex)
        End If
    End If
End Property

MoveNext を用いた集計処理

上記のクラスを使えば、記述内容がすっきりする。

    Dim col As Collection
    Dim v As Variant
    Dim strWork As String
    Dim lngCnt As Long
    
    Set col = New Collection
    
    col.Add "あ"
    col.Add "い"
    col.Add "い"
    col.Add "う"
    col.Add "え"
    col.Add "え"
    col.Add "お"
    col.Add "お"
    
    Dim cc As CollectionCursor
    
    Set cc = New CollectionCursor
    cc.Init col
    
    Do Until cc.Eof
    
        '初期化
        strWork = cc.item
        lngCnt = 0
            
        '集計処理
        Do Until cc.Eof Or strWork <> cc.item
    
            lngCnt = lngCnt + 1
            
            cc.MoveNext
        Loop
        
        '集計結果
        Debug.Print strWork & lngCnt
        
   Loop

あ1
い2
う1
え2
お2

見てわかる通り、初期化を行う場所、集計する場所、修正結果を表示する場所が一目瞭然であると思う。ループの中で次のコレクションに移動できないとこういったロジックを書くことができない。