Ver Mensaje Individual
  #2 (permalink)  
Antiguo 12/03/2010, 10:48
Avatar de pkj
pkj
 
Fecha de Ingreso: julio-2006
Ubicación: Órbita sincrónica
Mensajes: 899
Antigüedad: 18 años, 4 meses
Puntos: 29
Respuesta: Comprimir Cadena Ayuda Urgente!

A ver que te parece...

Código vb:
Ver original
  1. Function Comprime(Cadena As String) As String
  2.   Dim Matriz1() As String
  3.   Dim Matriz2() As String
  4.   Dim Cadena1 As String
  5.   Dim Cadena2 As String
  6.   Dim F As Long
  7.  
  8.   Matriz1 = Split(Cadena, ";")
  9.   ReDim Matriz2(0)
  10.   Matriz2(0) = Matriz1(0)
  11.   For F = 1 To UBound(Matriz1)
  12.     Cadena1 = Left$(Matriz1(F), InStrRev(Matriz1(F), ":"))
  13.     Cadena2 = Left$(Matriz2(UBound(Matriz2)), InStrRev(Matriz2(UBound(Matriz2)), ":"))
  14.     If Cadena1 = Cadena2 Then
  15.       Matriz2(UBound(Matriz2)) = Cadena1 & Val(Right$(Matriz2(UBound(Matriz2)), Len(Matriz2(UBound(Matriz2))) - Len(Cadena1))) + Val(Right$(Matriz1(F), Len(Matriz1(F)) - Len(Cadena1)))
  16.     Else
  17.       ReDim Preserve Matriz2(UBound(Matriz2) + 1)
  18.       Matriz2(UBound(Matriz2)) = Matriz1(F)
  19.     End If
  20.   Next F
  21.  
  22.   Comprime = Join(Matriz2, ";")
  23.  
  24. End Function

Permite sumar cuando ya se han sumado:

Tu ejemplo:
MsgBox Comprime("1:11:26:1;1:22:60:1;1:8:18:1;1:8:18:1;1: 8:18:1")
Resultado: 1:11:26:1;1:22:60:1;1:8:18:3

Apliación de sumas:
MsgBox Comprime("1:11:26:1;1:22:60:1;1:8:18:1;1:8:18:2;1:8:18:1")
Resultado: 1:11:26:1;1:22:60:1;1:8:18:4

Saludos
__________________
No hay preguntas tontas, solo gente estup..., ¡No!, ¿como era? No hay gente que pregunte a tontos... ¡Nooo!... ¡Vaya cabeza!