Function yyy$(t$)
   Dim i%
For i = 1 To Len(t)
If Mid(t, i, 1) Like "[0-9]" Then s = s & Mid(t, i, 1)
Next
  yyy = Trim(s)
End Function
Sub Сорт()
[A:A].Sort Key1:=[A1], Order1:=xlAscending, Header:=xlYes
   Dim i&, j&, x, t$
   x = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
     For i = 1 To UBound(x): t = x(i, 1)
        For j = 1 To Len(t)
         If Mid(t, j, 1) Like "[0-9]" Then s = s & Mid(t, j, 1)
       Next
        x(i, 1) = Trim(s): s = ""
     Next
   Range("A2").Resize(UBound(x), UBound(x, 2)).Value = x
   Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "0"
End Sub

Option Explicit

Sub qwert()
Dim rz, ubr, dob, diap, m, t, i, s, j, ЗК, pr As Boolean
Set rz = CreateObject("Scripting.Dictionary")
With Лист1
    Set ubr = Get_Spis(.Range("A1").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row).Value)
    Set dob = Get_Spis(.Range("B1").Resize(.Cells(.Rows.Count, 2).End(xlUp).Row).Value)
    Set diap = Get_Spis(.Range("C1").Resize(.Cells(.Rows.Count, 3).End(xlUp).Row).Value)
    For Each t In ubr.keys
        If diap.exists(t) Then diap.Remove (t)
    Next t
    For Each t In dob.keys: diap(t) = 0: Next t
    .[g1].Resize(diap.Count) = Application.Transpose(diap.keys)
    .Columns("G:G").Sort Key1:=Range("G" & diap.Count)
    ubr = .Range("g1:g" & diap.Count + 1).Value
    .Range("g1:g" & diap.Count + 1).ClearContents
    .Range("D2:D10000").ClearContents

    For i = 1 To UBound(ubr)
        t = ubr(i, 1)
        If Len(j) = 0 Then
            j = t: s = t
        Else
            If t - j = 1 Then
                j = t: pr = True
            Else
                rz(IIf(pr, s & "-" & j, s)) = 0: j = t: s = t: pr = False
            End If
        End If
    Next i
    
    .Range("D2:D" & rz.Count + 1) = Application.Transpose(rz.keys)
End With
    MsgBox diap.Count, , ""
End Sub

Private Function Get_Spis(s)
Dim N, k, u, i, j
Dim os: Set os = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(s)
    u = Split(s(i, 1), "-"): N = CDbl(u(0)): k = CDbl(u(UBound(u)))
    For j = N To k: os(j) = 0: Next j
Next i
Set Get_Spis = os
End Function