Function ConcNum(rng As Range) As String
Dim s$, x, i&, bu As Boolean
s = Replace(Join(Filter(Split("~" & Join(Application.Index(rng.Value, 1, 0), "~|~") & _
"~", "|"), "~~", 0), ", "), "~", "") & ", 9E+307"
x = Split(s, ","): s = ""
For i = 0 To UBound(x) - 1
s = s & ", " & Trim(x(i))
Do While Val(x(i)) = Val(x(i + 1)) - 1
bu = True: i = i + 1
Loop
If bu Then s = s & "-" & Trim(x(i)): bu = False
Next i
ConcNum = Mid(s, 3)
End Function
Function ConcNum22(rng As Range) As String
Dim x, i&, s$, bu As Boolean
With rng
x = .Resize(.Count + 1).Value
End With: s = x(1, 1)
For i = 2 To UBound(x)
If x(i, 1) <> x(i - 1, 1) + 1 Then
s = IIf(bu = False, s & ", " & x(i, 1), s & "-" & x(i - 1, 1) & ", " & x(i, 1))
bu = False
Else
bu = True
End If
Next i
ConcNum22 = Left(s, Len(s) - 2)
End Function
Function ConcNum33(rng As Range) As String 'если числа в одной ячейке
Dim s$, x, i&, bu As Boolean
x = Split(rng.Value & " ")
If UBound(x) = 0 Then ConcNum33 = x(0): Exit Function
For i = 0 To UBound(x) - 1
s = s & ", " & Trim(x(i))
Do While Val(x(i)) = Val(x(i + 1)) - 1
bu = True: i = i + 1
Loop
If bu Then s = s & "-" & Trim(x(i)): bu = False
Next i
ConcNum33 = Mid(s, 3)
End Function
Function ConcNum44(rng As Range) As String 'если в ячейке даты, например так:
'30.09.2015, 31.10.2015, 30.11.2015, 31.12.2015, 31.01.2016, 31.05.2016, 30.06.2016, 31.07.2016
Dim s$, x, i&, bu As Boolean
x = Split(rng.Value & ", 31.12.2100", ", ")
If UBound(x) = 0 Then ConcNum44 = x(0): Exit Function
For i = 0 To UBound(x) - 1
s = s & ", " & x(i)
Do While DateDiff("m", x(i), x(i + 1), vbMonday, vbUseSystem) < 2
bu = True: i = i + 1
Loop
If bu Then s = s & "-" & x(i): bu = False
Next i
ConcNum44 = Mid(s, 3)
End Function
|