|
数えながら出力するほうが、簡単かな。
Sub test2()
Dim rngLoop As Range
Dim lngCnt As Long
Dim strPre As String
Dim rngResult As Range
Dim i As Long
'初期値設定
lngCnt = 0
strPre = ""
i = 1
'結果出力範囲設定
Set rngResult = Range("R110:AC150")
rngResult.ClearContents
For Each rngLoop In Range("R5:AC107")
'1つ前のセルと同値ならカウンタをカウントアップ
If rngLoop.Value = strPre Then
lngCnt = lngCnt + 1
'値が変わったら出力
Else
If lngCnt <> 0 Then
rngResult.Cells(i).Value = lngCnt
i = i + 1
End If
lngCnt = 1
strPre = rngLoop.Value
End If
Next rngLoop
'最終データの書き込み
rngResult.Cells(i).Value = lngCnt
'オブジェクト開放
Set rngResult = Nothing
End Sub
|
|