Public Function Склейка(ByRef rng As Range)
Dim n, arr1, s As String, x As String, y As Double, m As Byte
On Error GoTo ErrHand
Set re = CreateObject("VBScript.RegExp")
Set dic = CreateObject("System.Collections.SortedList")
re.Global = True: re.Pattern = "/\d+$"
arr1 = rng
For Each n In arr1
If n <> "" Then
If re.Test(n) Then
x = Split(n, "/")(0)
y = CDbl(Split(n, "/")(1))
If Not dic.Contains(x) Then Set dic(x) = CreateObject("System.Collections.SortedList")
If Not dic(x).Contains(y) Then dic(x).Add y, n
Else
If Not dic.Contains(n) Then Set dic(n) = CreateObject("System.Collections.SortedList")
If Not dic(n).Contains(99 ^ 9) Then dic(n).Add 99 ^ 9, n
End If
End If
Next n
s = ""
m = 0
For n = 0 To dic.Count - 1
If dic(dic.GetKey(n)).Count > 1 Then
For y = 0 To dic(dic.GetKey(n)).Count - 2
If Round(Fix(dic(dic.GetKey(n)).GetKey(y)) - Round(dic(dic.GetKey(n)).GetKey(y), 4), 4) = 0 Then f = 1 Else f = 0.0001
If Round(dic(dic.GetKey(n)).GetKey(y + 1) - dic(dic.GetKey(n)).GetKey(y), 4) = f Then
m = m + 1
ElseIf Round(dic(dic.GetKey(n)).GetKey(y + 1) - dic(dic.GetKey(n)).GetKey(y), 4) <> f Then
If m > 0 Then
s = s & "; " & dic(dic.GetKey(n)).GetByIndex(y - m) & "-" & Split(dic(dic.GetKey(n)).GetByIndex(y), "/")(1)
m = 0
ElseIf m = 0 Then
s = s & "; " & dic(dic.GetKey(n)).GetByIndex(y)
m = 0
End If
End If
Next
If m <> 0 Then
s = s & "; " & dic(dic.GetKey(n)).GetByIndex(dic(dic.GetKey(n)).Count - m - 1) & "-" & Split(dic(dic.GetKey(n)).GetByIndex(dic(dic.GetKey(n)).Count - 1), "/")(1)
m = 0
Else
s = s & "; " & dic(dic.GetKey(n)).GetByIndex(dic(dic.GetKey(n)).Count - 1)
End If
Else
s = s & "; " & dic(dic.GetKey(n)).GetByIndex(dic(dic.GetKey(n)).Count - 1)
m = 0
End If
Set dic(dic.GetKey(n)) = Nothing
Next n
Склейка = Mid(s, 3)
Set dic = Nothing
Exit Function
ErrHand:
Склейка = "Ошибка"
End Function