sbParseNumSeq (VBA)

Wed, 03 Jun 2026 13:11:00 +0100

Abstract

Gliedere eine Zahlenfolge auf und gib eine kürzere Darstellung zurück: 1,2,3,5,6,7 wird zurückgegeben als 1-3,5-7. Falls bWithSingleDouble = TRUE, dann wird 1,3,5,6,8,10 zurückgegeben als 1-5(single),6-10(double).

Appendix sbParseNumSeq Code

Bitte den Haftungsausschluss im Impressum beachten.

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): https://www.sulprobil.de/sbparsenumseq_en/
'Source (DE): https://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

Bitte den Haftungsausschluss im Impressum beachten.

SbParseNumSeq on Bernd Plumhoff

sbParseNumSeq (VBA)

Abstract

Appendix sbParseNumSeq Code

Download