[SRC] Abbreviate_Numeric_Array [ by Mr. Frog © ]

[Psyke1]

Hola chicos, esta es mi ultima funcion que sirve para simplificar arrays numéricos.
En realidad es un reto que me puso mi buen amigo BlackZer0X!

Añadir mi clase cCollectionEx.cls

Código: (vb) [Seleccionar]

'=========================================================
' º 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
Ejemplo:

Código: (vb) [Seleccionar]

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
Obtengo esto:

1~7|65|345|4545~4547|9999999|9999999999|

Ahora mi funcion para desabreviar...

Código: (vb) [Seleccionar]

'=========================================================
' º Function : DeAbbreviate_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

Public Function DeAbbreviate_Numeric_Array(ByRef sNumbersItems() As String) As cCollectionEx
If (Not sNumbersItems) = -1 Then Exit Function
Dim cExTemp                                         As New cCollectionEx
Dim sActualItem                                     As String
Dim sNumbers()                                      As String
Dim lToTalItems                                     As Long
Dim Q                                               As Long
Dim W                                               As Long
    lToTalItems = UBound(sNumbersItems())
    If lToTalItems > 2 Then
        For Q = 0 To lToTalItems
            sActualItem = sNumbersItems(Q)
            If sActualItem Like "*~*" Then
                sNumbers() = Split(sActualItem, "~")
                For W = CDbl(sNumbers(0)) To CDbl(sNumbers(1))
                    cExTemp.Add W
                Next W
            Else
                cExTemp.Add sActualItem
            End If
        Next Q
        Set DeAbbreviate_Numeric_Array = cExTemp
    End If
End Function
Un ejemplo:

Código: (vb) [Seleccionar]

Private Sub Form_Load()
Dim sArray()                    As String
Dim Q                           As Long
 
    sArray() = Split("1|2|8|9|34|56~58|9999~10002|", "|")
    With DeAbbreviate_Numeric_Array(sArray())
        For Q = 1 To .Count
            Debug.Print .Item(Q)
        Next Q
    End With
End Sub
Me da esto:

1
2
8
9
34
56
57
58
9999
10000
10001
10002

Alternativa:
http://goo.gl/xrkLF

DoEvents!