|
こんにちは。
↓こんな感じでは如何でしょうか?
Sub test()
Dim rngLoop As Range
Dim strCnt As String
Dim varTmp As Variant
Dim lngCnt As Long
Dim strPre As String
lngCnt = 0
strPre = ""
For Each rngLoop In Range("A1:F3")
'1つ前のセルと同値ならカウンタをカウントアップ
If rngLoop.Value = strPre Then
lngCnt = lngCnt + 1
'値が変わったらカンマを挟んで個数を文字列に退避
Else
If lngCnt <> 0 Then strCnt = strCnt & "," & lngCnt
lngCnt = 1
strPre = rngLoop.Value
End If
Next rngLoop
'最終データの書き込み
strCnt = Mid(strCnt, 2) & "," & lngCnt
'カンマで区切って配列に格納
varTmp = Split(strCnt, ",")
'配列の内容をセルに展開
Cells(4, 1).End(xlToRight).ClearContents
Cells(4, 1).Resize(, UBound(varTmp) + 1).Value = varTmp
'配列初期化
Erase varTmp
End Sub
|
|