Функция склеивания цифр без повторов для Excel - VBA

Формулировка задачи:

Имеются две функции, которые нужно совместить Итак есть главная функция =СцепитьМного(J2:L100;", ";ИСТИНА) здесь ИСТИНА это пропуск повторов, запятыми сцепляются итак при сборке получилось такое, при этом отсеялись повторы 1, 7, 11, 12, 13, 17, 29, 30, 4, 6, 9, 10, 15, 16, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 31, 5, 2, 3 здесь они получились неупорядоченными в итоге эту функцию необходимо доработать. чтобы получилось как во второй функции =Sjatie2 и вышло, так, отсортированным и сжатым 1-7, 9-13, 15-17, 19-31 прикрепляю файл с кодом функции =СцепитьМного и с кодом функции =Sjatie2 из этих двух нужен один готовый универсальный

Решение задачи: «Функция склеивания цифр без повторов для Excel»

textual
                            Листинг программы 
                        

                            Function СцепкаУнив(Диапазон As Range, Optional Разделитель As String = " ", Optional БезПовторов As Boolean = False)
    Dim avData, lr As Long, lc As Long, sRes As String
    Dim a As Variant
    Dim cCount As Long
    Dim i As Long
    Dim i2 As Long
    
    avData = Диапазон.Value
    If Not IsArray(avData) Then
        СцепкаУнив = avData
        Exit Function
    End If
 
    For lc = 1 To UBound(avData, 2)
        For lr = 1 To UBound(avData, 1)
            If Len(avData(lr, lc)) Then
                sRes = sRes & Разделитель & avData(lr, lc)
            End If
        Next lr
    Next lc
    If Len(sRes) Then
        sRes = Mid(sRes, Len(Разделитель) + 1)
    End If
    
    If БезПовторов Then
        Dim oDict As Object, sTmpStr
        Set oDict = CreateObject("Scripting.Dictionary")
        sTmpStr = Split(sRes, Разделитель)
        On Error Resume Next
        For lr = LBound(sTmpStr) To UBound(sTmpStr)
            oDict.Add sTmpStr(lr), sTmpStr(lr)
        Next lr
        sRes = ""
        sTmpStr = oDict.keys
        For lr = LBound(sTmpStr) To UBound(sTmpStr)
            sRes = sRes & IIf(sRes <> "", Разделитель, "") & sTmpStr(lr)
        Next lr
    End If
    
    'Сжатие
    
    a = Split(sRes, Разделитель)
    Dim tSplit As Variant: ReDim tArr(LBound(a, 1) To UBound(a, 1), 1 To 3)
 
 
cCount = 0
For i = LBound(a, 1) To UBound(a, 1)
    If InStr(a(i), Разделитель) Then
        tSplit = Split(a(i), Разделитель)
        tArr(i, 1) = tSplit(LBound(tSplit))
        tArr(i, 2) = tSplit(UBound(tSplit))
        cCount = cCount + 1 + tArr(i, 2) - tArr(i, 1)
    Else
        tArr(i, 1) = a(i)
        tArr(i, 2) = a(i)
        cCount = cCount + 1
    End If
Next
 
Dim rRange: ReDim rRange(1 To cCount, 1 To 1)
 
cCount = 0
' разворачиваем
For i = LBound(a, 1) To UBound(a, 1)
    For i2 = tArr(i, 1) To tArr(i, 2)
        cCount = cCount + 1
        rRange(cCount, 1) = i2
    Next
Next
 
' сортируем массив по возрастанию
rRange = CoolSort(rRange, 1)
 
' получаем сжатую строку
СцепкаУнив = Sjatie(rRange)
 
End Function
                        