用范围replace连续的数字
我如何在一个单元格中find连续的数字，并将其replace为一个范围？
例如：
更改：
1,3,5,15,16,17,25,28,29,31 …
至：
1,3,5,15-17,25,28-29,31 …
这些数字已经sorting，即按升序排列。
谢谢。
我想看一个有趣的问题，就是不循环序列（这需要先sorting），然后检查顺序构build
这个function
- 强制string到一个范围地址
- 使用
Union将连续的行组合在一起 - 操纵string以删除列标识符
循环没有必要，更短的版本！
Function NumOut(strIn As String) As String Dim rng1 As Range Set rng1 = Range("A" & Join(Split(Application.Trim([a1]), ", "), ",A")) 'force the range into areas rather than cells Set rng1 = Union(rng1, rng1) NumOut = Replace(Replace(Replace(rng1.Address, "$A$", vbNullstring), ": ", "-"), ",", ", ") End Function
虽然给定的范围/面积为基础的答案是有趣的，它有两个缺陷：
- 它仅限于255个字符的inputstring
- 这是比较慢的
这是一个基本的基于数组循环的方法。 它可以处理长string。 在我的testing中，它运行了大约三分之一的时间。 它也有不需要inputsorting的好处
Function NumOut2(strIn As String) As String Dim arrIn() As String Dim arrBuckets() As Long Dim i As Long Dim InRange As Boolean Dim mn As Long, mx As Long arrIn = Split(strIn, ", ") mn = arrIn(0) mx = arrIn(0) For i = 1 To UBound(arrIn) If arrIn(i) < mn Then mn = arrIn(i) ElseIf arrIn(i) > mx Then mx = arrIn(i) End If Next ReDim arrBuckets(mn To mx) For i = 0 To UBound(arrIn) arrBuckets(arrIn(i)) = arrIn(i) Next NumOut2 = LBound(arrBuckets) InRange = False For i = LBound(arrBuckets) + 1 To UBound(arrBuckets) If arrBuckets(i) > 0 Then If arrBuckets(i) = arrBuckets(i - 1) + 1 Then If InRange Then Else InRange = True NumOut2 = NumOut2 & "-" End If Else If InRange Then NumOut2 = NumOut2 & arrBuckets(i - 1) & ", " & arrBuckets(i) Else NumOut2 = NumOut2 & ", " & arrBuckets(i) End If End If Else If InRange Then NumOut2 = NumOut2 & arrBuckets(i - 1) End If InRange = False End If Next End Function