Public Function Сборка_мас(ByRef rng As Range)
Dim n, arr(), s As String, x As String, y As Integer, m As Byte, rn As Range
On Error GoTo ErrHand
Set re = CreateObject("VBScript.RegExp")
Set dic = CreateObject("Scripting.Dictionary")
re.Global = True: re.Pattern = "\d+"
ReDim arr(1 To rng.Rows.Count, 1 To 1)
k = 0
For Each rn In rng
    k = k + 1
    s = Replace(Replace(rn, ",", ";"), " ", "")
    arr1 = Split(s, ";")
    For Each n In arr1
        If n <> "" Then
            x = re.Replace(n, "")
            y = CInt(Replace(n, x, ""))
            If Not dic.Exists(x) Then Set dic(x) = CreateObject("System.Collections.SortedList")
            If Not dic(x).contains(y) Then dic(x).Add y, y
        End If
    Next n
    s = ""
    m = 0
    For Each n In dic
        If dic(n).Count > 1 Then
            For y = 0 To dic(n).Count - 2
                If dic(n).GetKey(y) = dic(n).GetKey(y + 1) - 1 Then
                    m = m + 1
                ElseIf dic(n).GetKey(y) <> dic(n).GetKey(y + 1) - 1 And m > 0 Then
                    s = s & "; " & n & Format(dic(n).GetKey(y - m), "0##") & "-" & n & Format(dic(n).GetKey(y), "0##")
                    m = 0
                ElseIf dic(n).GetKey(y) <> dic(n).GetKey(y + 1) - 1 And m = 0 Then
                    s = s & "; " & n & Format(dic(n).GetKey(y), "0##")
                    m = 0
                End If
            Next
            If m <> 0 Then
                s = s & "; " & n & Format(dic(n).GetKey(dic(n).Count - m - 1), "0##") & "-" & n & Format(dic(n).GetKey(dic(n).Count - 1), "0##")
            Else
                s = s & "; " & n & Format(dic(n).GetKey(dic(n).Count - 1), "0##")
            End If
        Else
            s = s & "; " & n & Format(dic(n).GetKey(dic(n).Count - 1), "0##")
        End If
        m = 0
        Set dic(n) = Nothing
    Next n
    arr(k, 1) = Mid(s, 3)
    dic.RemoveAll
Next rn
Сборка_мас = arr
Exit Function
ErrHand:
Сборка_мас = "Ошибка"
End Function

Public Function Сборка(ByRef rng As Range)
Dim n, s As String, x As String, y, m As Byte
On Error GoTo ErrHand
Set re = CreateObject("VBScript.RegExp")
Set dic = CreateObject("System.Collections.SortedList")
re.Global = True: re.Pattern = "\d+(\.\d+)?$"
s = Replace(Replace(rng.Value, ",", ";"), " ", "")
Arr1 = Split(s, ";")
For Each n In Arr1
    If n <> "" Then
        If re.Test(n) Then
            x = re.Replace(n, "")
            a = Split(Replace(n, x, ""), ".")
            y = CInt(a(0))
            If UBound(a) > 0 Then y1 = CDbl(a(1)) / 10000 Else y1 = CDbl(0)
            y = Fix(y) + y1
            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(n) Then dic(n).Add n, 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) & "-" & dic(dic.GetKey(n)).GetByIndex(y)
                    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) & "-" & dic(dic.GetKey(n)).GetByIndex(dic(dic.GetKey(n)).Count - 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