CODEWITHSUNDEEP
excelexcel-formulavba
chen
chen

Reputation: 49

Replace sequential numbers with a range

How can I find sequential numbers in a cell, and replace them with a range?
For example:

change:

1，3，5，15，16，17，25，28，29，31...

to:

1,3,5,15-17,25,28-29,31...

The numbers are already sorted, i.e. in increasing order.

Thanks.

Upvotes: 2

Views: 913

Answers (3)

JvdV
JvdV

Reputation: 75870

Thought I'd try an all-formulae solution using Microsoft365's LET() as a way to capture variables.

The below solution only counts 3+ consecutive numbers as ranges of numbers, not two.

enter image description here

Formula in B1:

=LET(X,FILTERXML("<t><s>"&SUBSTITUTE(A1,",","</s><s>")&"</s></t>","//s"),Y,TRANSPOSE(FILTERXML("<t><s>"&SUBSTITUTE(A1,",","</s><s>")&"</s></t>","//s[preceding::*[1]+1=.][following::*[1]-1=.]")),SUBSTITUTE(TEXTJOIN(",",,FILTERXML("<t><s>"&TEXTJOIN("</s><s>",,IF(MMULT(--(X=Y),SEQUENCE(COUNTA(Y),,,0)),"-",X))&"</s></t>","//s[.*0=0 or (.='-' and preceding::*[1]*0=0)]")),",-,","-"))

Upvotes: 4

brettdj
brettdj

Reputation: 55682

An interesting question that I wanted to look at do without looping through a sequence (which would need sorting first) checking for sequential builds

This function

  1. forces the string to a range address
  2. uses Union to group consecutive rows together
  3. manipulates the string to remove the column identifier

enter image description here

loop wasn't necessary, shorter version!

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

Upvotes: 6

chris neilsen
chris neilsen

Reputation: 53126

While the given range/area based answer is interesting, it suffers from a couple of flaws:

  • It is limited to an input string of 255 characters
  • It is relatively slow

Here's a basic array loop based method. It can handle long strings. In my testing it runs in about 1/3 the time. It also has the bonus of not requiring the input to be sorted

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

Upvotes: 3

Related Questions