Buenas compañeros,

Me enfrento a un problema de programación con VBA que parece complicado, a ver si me pueden echar una mano ya que he investigado y no encuentro la manera de hacerlo.

En la siguiente imagen, en la columna B están las "Acciones". Dentro de las celdas de esta columna hay texto con información relativa al trabajo realizado.

Mi intención es buscar todas las veces que se repite la cadena "Sub-task stamped" dentro de una misma celda  y extraer la fecha y hora que está en el renglón justo de  abajo.

En el Ejemplo de la imagen el resultado sería: 

    -Sub-task Stamped: 10-Mar-2020 21:20

    - Sub-task Stamped: 10-Mar-2020 19:03

nota: Podría haber filas como es la B3 en la que no aparece esta cadena de texto, en ese caso no hay que hacer nada

Adjunto archivo, para visualizar la situación

Les agradecería enormemente que me puedieran ayudar a resolver el problema compañeros

Muchas gracias de antemano

Un abrazo

extraertexto.xlsm

Prueba con esta macro:

Sub BuscarFechas()
Application.ScreenUpdating = False
For x = 2 To Range("B" & Rows.Count).End(xlUp).Row
   Range("B" & x).Select
   fechas = Split(Range("B" & x), "/* ")
   For f = 1 To UBound(fechas)
      ActiveCell.Offset(0, 1).Select
      ActiveCell = Left(fechas(f), 15)
   Next
Next
End Sub

 

Buenas Antoni, en primer lugar muchisimas gracias por su aportación, es muy interesante!

Sin embargo, esta macro sólo extrae la última fecha dentro de la celda, y sin relacionarla con la cadena de texto " Sub-task stamped".

Me faltaría añadir alguna condición para localizar todas las veces que se repite  "Sub-task stamped" dentro de la celda y extraer la fecha de la forma que indica en su macro.

Es posible que haya celdas que no tengan la cadena  "Sub-task stamped" y no haya que extraer nada.

Un cordial saludo

Mañana lo miro más a fondo. ?

Cuando usted pueda!

Muchas gracias

Un saludo

¡Hola, a todos!

Puedes probar con el siguiente código:

Sub ExtraeFechas()
  Dim i&, j&, cadenas, fecha$
  
  Application.ScreenUpdating = False
  For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
    cadenas = Split(Range("B" & i), "Sub-task stamped")
    If UBound(cadenas) Then
      For j = 1 To UBound(cadenas)
        fecha = Split(cadenas(j), "/*")(1)
        Range("C" & i).Offset(, j - 1) = Trim(Mid(fecha, 2, 18))
      Next j
    End If
  Next i
  
  Erase cadenas
  Application.ScreenUpdating = True
End Sub

¡Bendiciones!

Viendo la solución de SiexL, ya no es necesaria la mía. ?

John Jairo  V fantastica solución, muy creativa... la macro hace exactamente lo que quiero!

Muchisimas gracias por su valiosa ayuda. Doy por resuelto el tema!

Antoni muchas gracias también a usted por su aportación y dedicación

Un abrazo