Test Foro de elhacker.net SMF 2.1

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

Añadir mi clase cCollectionEx.cls (http://foro.elhacker.net/programacion_visual_basic/src_ccollectionexcls_by_psyke1-t302651.0.html)


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


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:

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

---

Ahora mi funcion para desabreviar... :P


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


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:

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

DoEvents! :P

Es un muy buen ejercicio para pillar conceptos de lógica.

Muy bueno y gracias por compartir ;)

Saludos

Me ha gustado :D, ahora falta que hagas la funcion que des-abrevia :P, si no esto no tiene utilidad :xD
Seria interesante que tambien pudiese detectar series de multiples por ejemplo...

Lo unico que no me gusta es que abusas de hacer las cosas en una linea, por ejemplo:
If lActualNumber + c = lNumberList(n) Then n = n + 1: c = c + 1 Else Exit Do
A me me gusta mucho mas asi, se ve mejor la logica:
If lActualNumber + c = lNumberList(n) Then
       n = n + 1
       c = c + 1
Else
       Exit Do
End If

Saludos ;)

Gracias! ;D
Si, lo de las series multiples era una de las cosas a implementar, buena idea lo de "des-abreviar"... :laugh: (Lo metere tambien, buena idea) ;)
En cuanto lo de las lineas es pura costumbre, auque tienes razon que es mas "entendible" como me has puesto... :silbar:
En unos dias posteo la nueva :P

Salu2 y Gracias a ambos! :-* :laugh:

A mi también me ha gustado y estoy de acuerdo con eso con Karcrack, hay que hacer el código un poco más legible..(y hasta aunque sea para uno mismo)

Buen trabajo ;)

He hecho la funcion de desabreviar :P
Option Explicit

Private Sub Form_Load()
   Dim vItem       As Variant
   
   For Each vItem In DeAbbreviate("1|2|8|9|34|56~58|9999~10002|")
       Debug.Print vItem;
   Next vItem
End Sub

Public Function DeAbbreviate(ByVal sString As String) As Double()
   Dim bvTemp()    As String
   Dim i           As Long
   Dim n           As Long
   Dim w           As Long
   Dim dFir        As Double
   Dim dLas        As Double
   Dim bvResult()  As Double
   
   bvTemp = Split(sString, "|")
   
   For i = LBound(bvTemp) To UBound(bvTemp)
       If bvTemp(i) Like "*~*" Then
           dFir = Val(Split(bvTemp(i), "~")(0))
           dLas = Val(Split(bvTemp(i), "~")(1))
           ReDim Preserve bvResult(0 To (n + (dLas - dFir)))
           For n = n To (n + (dLas - dFir))
               bvResult(n) = dFir + w
               w = w + 1
           Next n
           w = 0
           n = n - 1
       ElseIf bvTemp(i) <> vbNullString Then
           ReDim Preserve bvResult(0 To n)
           bvResult(n) = bvTemp(i)
       End If
       n = n + 1
   Next i
   
   DeAbbreviate = bvResult
End Function

Supongo que se podria acortar un poco, pero creo que asi queda muy claro lo que hace :D

Saludos ;)

@Karcrack
Te odio!!! :laugh: :laugh:
Queria hacerlo yo antes... :¬¬
No obstante no voy a mirar tu code, y publicare mi alternativa, despues mirare el tuyo... :P

JAJAJAJA :xD

Salu2! ;)

Bueno como habeis visto, he posteado la funcion de desabreviar  ;-)
Tambien he quitado algunos ":" para que la funcion sea mas legible (siguiendo vuestro consejo ;) )
Voy a ver tu funcion Karcrack, aunque debo de admitir que hay cosas que no entiendo, las buscare y si tengo dudas pregunto... :D

Salu2 y Gracias! :P

Aun le falta...!¡.



Dim tt(100) As Double
tt(0) = 6
tt(1) = 8
tt(2) = 9
tt(3) = 10
tt(4) = 11
tt(5) = 12
tt(6) = 12
tt(7) = 12
tt(8) = 13
tt(9) = 14
tt(10) = 15
tt(11) = 16
tt(12) = 17
tt(13) = 18
tt(14) = 19
tt(15) = 19
tt(16) = 19
tt(17) = 20
tt(18) = 20
tt(19) = 21
tt(20) = 21
tt(21) = 22
tt(22) = 23
tt(23) = 24
tt(24) = 24
tt(25) = 25
tt(26) = 25
tt(27) = 25
tt(28) = 27
tt(29) = 28
tt(30) = 29
tt(31) = 31
tt(32) = 33
tt(33) = 34
tt(34) = 34
tt(35) = 35
tt(36) = 35
tt(37) = 37
tt(38) = 37
tt(39) = 38
tt(40) = 39
tt(41) = 40
tt(42) = 43
tt(43) = 43
tt(44) = 44
tt(45) = 44
tt(46) = 45
tt(47) = 45
tt(48) = 46
tt(49) = 47
tt(50) = 48
tt(51) = 48
tt(52) = 48
tt(53) = 49
tt(54) = 50
tt(55) = 50
tt(56) = 52
tt(57) = 54
tt(58) = 56
tt(59) = 56
tt(60) = 56
tt(61) = 57
tt(62) = 59
tt(63) = 60
tt(64) = 61
tt(65) = 62
tt(66) = 63
tt(67) = 64
tt(68) = 65
tt(69) = 66
tt(70) = 66
tt(71) = 67
tt(72) = 69
tt(73) = 70
tt(74) = 70
tt(75) = 72
tt(76) = 73
tt(77) = 74
tt(78) = 75
tt(79) = 75
tt(80) = 76
tt(81) = 76
tt(82) = 77
tt(83) = 80
tt(84) = 81
tt(85) = 85
tt(86) = 87
tt(87) = 88
tt(88) = 88
tt(89) = 89
tt(90) = 89
tt(91) = 91
tt(92) = 92
tt(93) = 92
tt(94) = 94
tt(95) = 94
tt(96) = 95
tt(97) = 95
tt(98) = 96
tt(99) = 96
tt(100) = 97



Resultado:



6|8~12|12|12~19|19|19|20|20|21|21~24|24|25|25|25|27~29|31|33|34|34|35|35|37|37~40|43|43|44|44|45|45~48|48|48~50|50|52|54|56|56|56|57|59~66|66|67|69|70|70|72~75|75|76|76|77|80|81|85|87|88|88|89|89|91|92|92|94|94|95|95|96|96|97|



Sangriento Infierno Lunar!¡.

Si si Black! :)
Ya dije que faltaba eso aun... :P
Lo corrigo en estos dias...

Salu2! ;)