Modificar Cadena

[assdres]

Hola a todos!!

Tengo el siguiente código:

Código:

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. Ahora necesito modificar ese código para que me sume los tres últimos, excepto el primero.

Muchas gracias a todos!!!