'
' /////////////////////////////////////////////////////////////
' // 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