Abstract
Parse a comma-separated number sequence and return a shortened representation: 1,2,3,5,6,7 will result in 1-3,5-7. If bWithSingleDouble = TRUE then 1,3,5,6,8,10 will result in 1-5(single),6-10(double).
Appendix sbParseNumSeq Code
Please read my Disclaimer.
Option Explicit
Function sbParseNumSeq(s As String, _
Optional bWithSingleDouble As Boolean = True) As String
'Parse a comma-separated number sequence and return a
'shortened representation:
'1,2,3,5,6,7 will result in 1-3,5-7.
'If bWithSingleDouble = TRUE then
'1,3,5,6,8,10 will result in 1-5(single),6-10(double).
'Source (EN): http://www.sulprobil.de/sbparsenumseq_en/
'Source (DE): http://www.berndplumhoff.de/sbparsenumseq_de/
'(C) (P) by Bernd Plumhoff 08-Sep-2024 PB V0.1
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim sDel As String
Dim suffix As String
Dim r As String
Dim v As Variant
v = Split(s, ",")
j = UBound(v)
ReDim seq(0 To j, 0 To 2) As Long
For i = 0 To j - 1
k = v(i + 1)
If k = v(i) + 1 Then
m = i + 1
Do While m < j
If v(m) + 1 = CLng(v(m + 1)) Then
m = m + 1
Else
Exit Do
End If
Loop
seq(i, 0) = 1
seq(i, 1) = m - i
ElseIf bWithSingleDouble And k = v(i) + 2 Then
m = i + 1
Do While m < j
If v(m) + 2 = CLng(v(m + 1)) Then
m = m + 1
Else
Exit Do
End If
Loop
seq(i, 0) = 2
seq(i, 2) = m - i
End If
Next i
For i = 0 To j
If seq(i, 0) = 0 Then
r = r & sDel & v(i)
Else
k = seq(i, seq(i, 0))
m = seq(i + k, seq(i + k, 0))
If k > 0 And k >= m Then
suffix = ""
If seq(i, 0) = 2 Then
If v(i) Mod 2 = 0 Then
suffix = "(double)"
Else
suffix = "(single)"
End If
End If
r = r & sDel & v(i) & "-" & v(i + k) & suffix
i = i + k
ElseIf k >= 2 Then
suffix = ""
If seq(i, 0) = 2 Then
If v(i) Mod 2 = 0 Then
suffix = "(double)"
Else
suffix = "(single)"
End If
End If
r = r & sDel & v(i) & "-" & v(i + k - 1) & suffix
i = i + k - 1
Else
r = r & sDel & v(i)
End If
End If
sDel = ","
Next i
sbParseNumSeq = r
End Function
Download
Please read my Disclaimer.
sbParseNumSeq.xlsm [24 KB Excel file, open and use at your own risk]