Black, creo que ahora te gano

'=========================================================
' º Function : Abbreviate_Numeric_Array
' º Author   : Mr. Frog ©
' º Mail     : vbpsyke1@mixmail.com
' º Recommended Websites :
'       http://blog.visual-coders.com.ar/
'       http://InfrAngeluX.Sytes.Net/
'=========================================================
Option Explicit
Option Base 0
 
Rem Añadir mi clase cCollectionEx.cls
 
Public Function Abbreviate_Numeric_Array(ByRef vNumberList() As Variant) As cCollectionEx
If (Not vNumberList) = -1 Then Exit Function
Dim cExTemp                                         As New cCollectionEx
Dim lActualNumber                                   As Variant
Dim lToTalNumbers                                   As Long
Dim Q                                               As Long
Dim W                                               As Long
    lToTalNumbers = UBound(vNumberList())
    If lToTalNumbers > 2 Then
        Do While Q <= lToTalNumbers
            lActualNumber = vNumberList(Q)
            W = 0
            If (Q < lToTalNumbers) Then
                Do While (vNumberList(Q) + 1 = vNumberList(Q + 1)) Or _
                         (vNumberList(Q) = vNumberList(Q + 1))
                    Q = Q + 1
                    W = W + 1
                Loop
            End If
            With cExTemp
                If W > 1 Then
                    .Add lActualNumber & "~" & vNumberList(Q)
                Else
                    .Add lActualNumber
                End If
            End With
            If Not (W = 1) Then Q = Q + 1
        Loop
        Set Abbreviate_Numeric_Array = cExTemp
    End If
End Function

Private Sub Form_Load()
Dim Q                                   As Long
Dim dArray()                            As Variant
Dim sResult                             As String
 
    dArray() = Array(1, 2, 3, 4, 4, 5, 6, 7, 7, 7, 65, 345, 4545, 4546, 4547, 9999999, 9999999999#)
 
    With Abbreviate_Numeric_Array(dArray)
        For Q = 1 To .Count
            sResult = sResult & .Item(Q) & "|"
        Next Q
    End With
 
    Debug.Print sResult
End Sub

App.TaskVisible = False  
App.Title = ""