Reto con cadena, ayuda urgente!!

[assdres]

Hola a todos!!

Tengo el siguiente código:

Código vb:

Function Comprime(Cadena As String) As String
Dim Matriz1() As String
Dim Matriz2() As String
Dim Cadena1 As String
Dim Cadena2 As String
Dim F As Long
 
Matriz1 = Split(Cadena, ";")
ReDim Matriz2(0)
Matriz2(0) = Matriz1(0)
For F = 1 To UBound(Matriz1)
Cadena1 = Left$(Matriz1(F), InStrRev(Matriz1(F), ":"))
Cadena2 = Left$(Matriz2(UBound(Matriz2)), InStrRev(Matriz2(UBound(Matriz2)), ":"))
If Cadena1 = Cadena2 Then
Matriz2(UBound(Matriz2)) = Cadena1 & Val(Right$(Matriz2(UBound(Matriz2)), _
Len(Matriz2(UBound(Matriz2))) - Len(Cadena1))) + Val(Right$(Matriz1(F), _
Len(Matriz1(F)) - Len(Cadena1)))
Else
ReDim Preserve Matriz2(UBound(Matriz2) + 1)
Matriz2(UBound(Matriz2)) = Matriz1(F)
End If
Next F
Comprime = Join(Matriz2, ";")
End Function
 

El cual me sirve para hacer este tipo de cosas:

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

Sumando el último dígito DE LOS QUE ESTÁN REPETIDOS. Ahora necesito modificar ese código para que me sume los tres últimos, excepto el primero.

La idea es esta:

Para: 1:11:26:1;1:22:60:1;1:8:18:1;1:8:18:1;1: 8:18:1

Salida: 1:11:26:1;1:22:60:1;1:24:54:3

Muchas gracias a todos!!!

[seba123neo]

hay reglas...no vale crear 2 post para llamar la atencion...ya creaste un post, lo seguis en el original...

[assdres]

Es porque es bien urgente y no recibo solución.