|
发表于 2014-8-28 18:39
|
显示全部楼层
本楼为最佳答案
- Sub suaa()
- Dim arr()
- Set Rng = Range("A4").CurrentRegion
- For i = 1 To Rng.Columns.Count
- n = 1
- s = Rng(n, i).Address(0, 0)
- sr = Rng(n, i).Value
- Do
- If Rng(n + 1, i) = Rng(n, i) Then
- e = Rng(n + 1, i).Address(0, 0)
- n = n + 1
- Else
- x = x + 1
- ReDim Preserve arr(1 To 2, 1 To x)
- arr(1, x) = s & "-" & e
- arr(2, x) = sr
- s = Rng(n + 1, i).Address(0, 0)
- sr = Rng(n + 1, i).Value
- n = n + 1
- End If
- Loop While n < Rng.Rows.Count + 1
- Next
- Sheets("汇总").Range("A2").Resize(UBound(arr, 2), UBound(arr)) = Application.Transpose(arr)
- End Sub
复制代码 |
|