Comparar varias filas y pasar solo una

Tengo la siguiente hoja donde registro los contratos por fechas y otros datos de trabajadores, y deseo pasar a otra hoja un solo contrato por trabajador donde indique su fecha inicial y final, por lo que desde ya agradezco su ayuda.

Código nombres f.inicio f.final
141415 jose carranza 16/12/2009 15/05/2015
141425 miguel lopez 11/03/2012 20/08/2013
141425 miguel lopez 21/08/2013 20/07/2014
141482 oscar pereda 13/05/2014 20/06/2015
141455 pedro ruiz 02/01/2013 05/03/2014
141425 miguel lopez 21/07/2014 15/07/2015
141473 juan perez 14/05/2012

1 Respuesta

Respuesta
1

Máximo.

Si el encabezado de tus datos comienza a partir de la celda A1 de la hoja activa, entonces podrías intentar con:

Sub RegistrosUnicos()
'------------------
'by Cacho Rodríguez
'------------------
Dim Mat, Dic, R&, Q&, i&
Mat = Range([a1], [a1].End(xlDown)).Resize(, 4)
Q = UBound(Mat)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To Q
  If Dic.Exists(Mat(i, 1)) Then
    R = Dic(Mat(i, 1))
    With Application: Mat(R, 3) = CDate(.Min(Mat(R, 3), Mat(i, 3)))
    Mat(R, 4) = CDate(.Max(Mat(R, 4), Mat(i, 4))): End With
  Else
    R = 1 + Dic.Count
    Dic.Item(Mat(i, 1)) = R
    Mat(R, 1) = Mat(i, 1): Mat(R, 2) = Mat(i, 2)
    Mat(R, 3) = Mat(i, 3): Mat(R, 4) = Mat(i, 4)
  End If
Next
Worksheets.Add.[a1:d1].Resize(R) = Mat
Dic = Empty: Mat = Empty
End Sub

¿Te sirve la idea?...

Mario

gracias es excelente.

solo quiero decirte que los encabezados de mi hoja son varios y de allí debo extraer  los datos; el codigo esta en la columna b2, el nombre en p2, f.inicio en q2 y f.final r2.

gracias.

n.condnicodsupplanillaconditipotip.descripgerenciajefe.inmedsedeareaseccapepapemnomnombresf.iniciof.terminof.renunciaf.cesemot.renunciamesestot.diasf.nacimientoedadfiscalizfiscaliz.descripfisc.desdetip.trabajovacacgaritaadmimporte

Sólo y porque planteaste mal tu consulta (jajajajajaj) vas a hacer las modificaciones tu mismo. A saber:

En lugar de:

Mat = Range([a1], [a1].End(xlDown)).Resize(, 4)

debe ir:

Mat = Range([b1], [b1].End(xlDown)).Resize(, 17)

'------------------

En lugar de los Mat(i, 2) deben ir: Mat(i, 15)

'------------------

En lugar de los Mat(i, 3) deben ir: Mat(i, 16)

'------------------

En lugar de los Mat(i, 4) deben ir: Mat(i, 17)

'------------------

Si modificas según lo sugerido y -encima- te funciona: ¡Definitivamente los milagros existen!
(Jajajajjjajajaj)

¡Gracias! 

Mario eres un trome.

Mario,

Al ejecutar la macro encontré un detalle importante que corregir, existen algunos trabajadores que no laboran de manera continua, entonces si dejan de  laborar por un día como mínimo debe salir dos filas por trabajador.

y por ultimo donde modifico si quiero extraer algún otro dato.

Espero tu gran apoyo.  

Lo que pides ahora, Máximo, no se trata de "un detalle importante que corregir"...

Se trata, en rigor, de un cambio de requerimiento tan importante que -literalmente- tira "al diablo" el esfuerzo y el tiempo empleado previamente:
- Primero has planteado una estructura de datos que no era la adecuada y hubo que cambiar el código inicial.

- Ahora planteas un cambio conceptual que -increíblemente- no mencionaste al inicio.

Te sugiero, entonces, que inicies una nueva consulta en un nuevo hilo.

Plantea allí tu necesidad sin omitir ningún detalle, acompañando tu descripción de un archivo reducido de muestra donde pueda verse lo que tienes y lo que deseas obtener.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas