Solo es un simple algoritmo para simplificación de números en un array!¡.

la idea es ingresar números y qué los Simplifique, es decir 1,2,3,4,5,9,10,15,16,17,18,555,342,423,422 los ordena de la siguiente manera:

1~5,9,10,15~18,555,342,423,422

si se integra un ordenamiento QuickSort ordenaría adecuadamente!¡.

OJO: NO Es RECOMENDABLE USARLO CON NÚMEROS DECIMALES!¡.

 
'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Código siempre y cuando   //
'   // no se eliminen los créditos originales de este código   //
'   // No importando qué sea modificado/editado o engrandecido //
'   // o achicado, si es en base a este código                 //
'   /////////////////////////////////////////////////////////////
Option Explicit
 
Public Function GetSimplificNumbers(ByRef ArrayOfNumbers() As Variant) As String()
If (Not ArrayOfNumbers) = -1 Then Exit Function '   //  Array entrante, iniciado?.
Dim Lng_ArrayTmp$()                             '   //  Colección de Números Simplificados!¡.
Dim Lng_Ini&, Lng_End&, Lng_Index&              '   //  Variables para el Bucle.
Dim Lng_AntPosNumber&                           '   //  Indice del Numero anterior (Numero del Array entrante).
Dim Lng_ResNumber&                              '   //  residuo de Lng_Index& - Lng_AntPosNumber&.
Dim Lng_ArrayCount&                             '   //  Contador de las dimensiones de Lng_ArrayTmp$.
Dim Bool_Swith                  As Boolean      '   //  swith para saber si se debe simplificar!¡.
 
    '   //  Call Start_QuickSort(ArrayOfNumbers(), AcendetOrder)    '   //  http://foro.elhacker.net/programacion_vb/source_ordenar_array_low_y_fast-t272312.0.html
 
    Lng_Ini = LBound(ArrayOfNumbers):   Lng_End = UBound(ArrayOfNumbers)
    ReDim Lng_ArrayTmp$(Lng_ArrayCount&)
    Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index&)
 
    For Lng_Index& = Lng_Ini + 1 To Lng_End
        Lng_ResNumber& = ArrayOfNumbers(Lng_Index&) - ArrayOfNumbers(Lng_Index& - 1)
        If Lng_ResNumber& > 1 Then
            If Bool_Swith Then
                If Lng_AntPosNumber& > 2 Then
                    Lng_ArrayTmp$(Lng_ArrayCount&) = Lng_ArrayTmp$(Lng_ArrayCount&) & "~" & ArrayOfNumbers(Lng_Index& - 1)
                Else
                    Lng_ArrayCount& = Lng_ArrayCount& + 1
                    ReDim Preserve Lng_ArrayTmp$(Lng_ArrayCount&)
                    Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index& - 1)
                End If
            End If
            Lng_ArrayCount& = Lng_ArrayCount& + 1
            ReDim Preserve Lng_ArrayTmp$(Lng_ArrayCount&)
            Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index&)
            Bool_Swith = False
        ElseIf Lng_ResNumber& = 1 Then
            If Not Bool_Swith Then Lng_AntPosNumber& = 0
            Bool_Swith = True
            If Lng_Index& = Lng_End Then
                If conversion.cbool(InStr(1, Lng_ArrayTmp$(Lng_ArrayCount& - 1), "~")) Then
                    Lng_ArrayCount& = Lng_ArrayCount& + 1
                    ReDim Preserve Lng_ArrayTmp$(Lng_ArrayCount&)
                    Lng_ArrayTmp$(Lng_ArrayCount&) = ArrayOfNumbers(Lng_Index&)
                Else
                    Lng_ArrayTmp$(Lng_ArrayCount&) = Lng_ArrayTmp$(Lng_ArrayCount&) & "~" & ArrayOfNumbers(Lng_Index&)
                End If
            Else
                Lng_AntPosNumber& = Lng_AntPosNumber& + 1
            End If
        ElseIf Lng_ResNumber& = 0 Then
            If Lng_AntPosNumber& > 0 Then
                Lng_AntPosNumber& = Lng_AntPosNumber& + 1
            Else
                Lng_AntPosNumber& = 0
            End If
        End If
    Next
    GetSimplificNumbers = Lng_ArrayTmp$
End Function
 
 

Ejemplo:

 
Public Function NumeroAleatorio(MinNum As Long, MaxNum As Long) As Long
Dim Tmp                                 As Long
    If MaxNum < MinNum Then: Tmp = MaxNum: MaxNum = MinNum: MinNum = Tmp
    Randomize: NumeroAleatorio = (MinNum - MaxNum + 1) * Rnd + MaxNum
End Function
 
Sub main()
Dim ArrayTmp() As Variant
Dim i&, i2&
    i& = 100
    ReDim ArrayTmp(i&)
    For i2& = 0 To i&
        ArrayTmp(i2&) = CStr(NumeroAleatorio(5, 99))
    Next
    Call Start_QuickSort(ArrayTmp(), AcendetOrder) '   //  http://foro.elhacker.net/programacion_vb/source_ordenar_array_low_y_fast-t272312.0.html
    Call MsgBox(Strings.Join(GetSimplificNumbers(ArrayTmp), ","))
End Sub
 
 

Alternativas:
http://foro.elhacker.net/programacion_visual_basic/src_abbreviatenumericarray_by_psyke1-t298689.0.html

P.D.: No escribí los números yo en Array fueron generados aleatoria-mente!¡.

Sangriento Infierno Lunar!¡.

 
Public Function NumeroAleatorio(MinNum As Long, MaxNum As Long) As Long
Dim Tmp                                 As Long
    If MaxNum < MinNum Then: Tmp = MaxNum: MaxNum = MinNum: MinNum = Tmp
    Randomize: NumeroAleatorio = (MinNum - MaxNum + 1) * Rnd + MaxNum
End Function
 
Sub main()
Dim ArrayTmp() As Variant
Dim i&, i2&
    i& = 100
    ReDim ArrayTmp(i&)
    For i2& = 0 To i&
        ArrayTmp(i2&) = CStr(NumeroAleatorio(5, 99))
    Next
    Call Start_QuickSort(ArrayTmp(), AcendetOrder) '   //  http://foro.elhacker.net/programacion_vb/source_ordenar_array_low_y_fast-t272312.0.html
    Call MsgBox(Strings.Join(GetSimplificNumbers(ArrayTmp), ","))
End Sub
 
 

Sangriento Infierno Lunar!¡.