|
Sub Macro1()
Dim arr, i&
'Range("a1").CurrentRegion.Sort [a2], Header:=xlYes
arr = Range("a2:a" & Range("a65536").End(xlUp).Row + 1)
x = arr(1, 1): p = ""
For i = 2 To UBound(arr) - 1
If Val(arr(i, 1)) - 1 <> Val(arr(i - 1, 1)) Then
p = p & " " & x & " - " & arr(i - 1, 1): x = arr(i, 1)
End If
Next
[c3] = Mid(p, 2) & " (" & UBound(arr) - 1 & ")"
End Sub
|
|