Modificar Cadena

[pkj]

No es muy dificil.
Se puede hacer mejor, pero si la cadena no es muy larga puede servir esto:

Código vb:

Function Comprime2(byVal Cadena As String) As String
  Dim Matriz1() As String
  Dim Matriz2() As String
  Dim Matriz1Temp() As String
  Dim Matriz2Temp() As String
  Dim F As Long
  Matriz1 = Split(Cadena, ";")
  ReDim Matriz2(0)
  Matriz2(0) = Matriz1(0)
  For F = 1 To UBound(Matriz1)
    Matriz1Temp = Split(Matriz1(F), ":")
    Matriz2Temp = Split(Matriz2(UBound(Matriz2)), ":")
    If Matriz1Temp(0) = Matriz2Temp(0) _
    And Matriz1Temp(1) / Matriz1Temp(3) = Matriz2Temp(1) / Matriz2Temp(3) _
    And Matriz1Temp(2) / Matriz1Temp(3) = Matriz2Temp(2) / Matriz2Temp(3) Then
      Matriz2(UBound(Matriz2)) = Matriz2Temp(0) & ":" _
      & Val(Matriz1Temp(1)) + Val(Matriz2Temp(1)) & ":" _
      & Val(Matriz1Temp(2)) + Val(Matriz2Temp(2)) & ":" _
      & Val(Matriz1Temp(3)) + Val(Matriz2Temp(3))
    Else
      ReDim Preserve Matriz2(UBound(Matriz2) + 1)
      Matriz2(UBound(Matriz2)) = Matriz1(F)
    End If
  Next F
  Comprime2 = Join(Matriz2, ";")
End Function
 

Saludos

PD: La proxima vez lo llamo "Function PKJZip"
Ten en cuenta que siguen sumandose los valores ya sumados, como en la anterior función.
Esta línea:
1:11:26:1;1:22:60:1;1:24:54:3;1:8:18:1;1:8:18:1;1: 8:18:1
Devuelve:
1:11:26:1;1:22:60:1;1:48:108:6