Ejecutar macro automáticamente

Buenas, tengo esta macro que se ejecuta automáticamente al meter los datos gracias a usted.
Private Sub Worksheet_Change(ByVal Target As Range)
' Quitar_hipervinculos Macro
'
'
While ActiveCell.Value <> ""
Selection.Hyperlinks.Delete
ActiveCell.Offset(1, 0).Range("A1").Select
Wend
End Sub
Los datos están en el siguiente formato:
2009-02-08 21:53:38: 80.3.251.39 Pepe [?]
2009-02-06 21:54:30: 120.165.89.50 Aster [?]
Me interesaría conseguir que de todo el listado que tengo, me ponga en la celda de al lado cuando el intervalo de horas es menor a 2 minutos.
Y que si se diera el siguiente caso también me lo colocara en la celda de al lado todos los datos:
2009-02-08 02:39:35: 90.6.39.37 Antonio [?]
2009-02-08 21:53:38: 90.6.39.37 Pepe [?]
Estuve probando con la función buscar y las demás que están relacionadas pero no fui capaz de llegar a nada, supongo que habrá que hacerlo con macros y estoy nulo al 100%, busque por la red pero no encontré nada que se le pareciera.
Muchas Gracias anticipadas.
Respuesta
1
Con respecto a la primera cuestión tengo una duda ¿el intervalo de tiempo es la diferencia entre las horas de una celda y otra? Si es así puede servirte la función "Extrae". A continuación coloco un ejemplo.
Suponiendo que los dos primeros datos de tu pregunta están en las celdas C6 y C7, en la celda D7 coloca:
=EXTRAE(C7;12;8) - EXTRAE(C6;12;8)
Posiblemente debes colocarle el formato adecuado (Formato de celda, Número, Hora) para que el resultado se vea como 0:00:52.
Luego con el formato condicional puedes elegir que si en esa celda el valor es mayor de 00:02:00 el fondo se vuelva rojo (por ej). (Si no sabes utilizar el formato condicional me avisas y lo explico).
Con respecto a la segunda cuestión, supongo que el punto es la repetición de 90.6.39.37, en este caso creo que también puede ser útil la función "Extrae" para luego comparar los valores y resaltarlos en caso de repetición.
He intentado darte algunas herramientas para que las ajustes a tus necesidades, si necesitas algo más específico, vuelve a responder en este tema y vemos de plantear algo más concreto.
Buenas, para la primera opción esta bien si se utilizar el formato condicional, si se pudiera realizar una macro que solo colocara las celdas menores o iguales a 2 minutos mejor.
Para la segunda opción no es valida la función EXTRAER, ya que en la cadena de texto conocemos el inicio pero no el final de la misma, me explico:
2009-02-08 21:53:38: 80.3.251.39 Pepe [?]
2009-02-06 21:54:30: 120.165.89.50 Fernando [?]
2009-02-08 02:39:35: 90.6.39.37 Antonio [?]
2009-02-08 21:53:38: 90.6.39.37 Pepe [?]
Como puedes ver la longitud del 2º ejemplo es puesto no es siempre el mismo, de igual modo que antes si pudiera ir en una macro mejor.
Gracias por tu pronta respuesta e interés.
Creo que encontré una fórmula para solucionar el segundo caso, de todas maneras intentaré realizar un par de macros para estos casos. Pero te pido un poco de tiempo para poder realizarlas.
Vuelvo a comunicarme.
Muchas gracias, el tiempo que necesites, la dejo abierta en espera de su respuesta.
Saludos
Te paso las rutinas de los dos puntos que hemos tratado. Ambas se desarrollaron considerando que los datos se encuentran en la columna A, desde la celda A1.
Deberás verificar los rangos de las celdas en las distintas sentencias. En el caso de la primera rutina tiene validez partiendo de B2 y la segunda desde C2.
... Primera rutina...
Do While ActiveCell.Offset(0, -1) <> ""
  Cadena1 = ActiveCell.Offset(-1, -1).Value
  Cadena2 = ActiveCell.Offset(0, -1).Value
  Dim Ext1 As Date
  Dim Ext2 As Date
  Dim Tiempo As Date
  Dim TiempoMin As Date
  TiempoMin = #12:02:00 AM#
  Ext1 = Mid(Cadena1, 12, 8)
  Ext2 = Mid(Cadena2, 12, 8)
  Tiempo = Ext2 - Ext1
  If Tiempo <= TiempoMin Then
  ActiveCell.Value = Tiempo
  Selection.NumberFormat = "h:mm:ss"
  End If
  ActiveCell.Offset(1, 0).Select
Loop
......................................................................
.................Segunda rutina...............................
Do While ActiveCell.Offset(0, -2) <> ""
  Cadena1 = ActiveCell.Offset(-1, -2).Value
  Cadena2 = ActiveCell.Offset(0, -2).Value
  Ext1 = Mid(Cadena1, 22, 15)
  Ext2 = Mid(Cadena2, 22, 15)
  Espacio1 = Application.WorksheetFunction.Find(" ", Ext1)
  Espacio2 = Application.WorksheetFunction.Find(" ", Ext2)
  Ext1 = Mid(Ext1, 1, Espacio1 - 1)
  Ext2 = Mid(Ext2, 1, Espacio2 - 1)
  If Ext1 = Ext2 Then ActiveCell.Value = Ext1
  ActiveCell.Offset(1, 0).Select
Loop
...

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas