Extraer registro Único de Varios Contratos
Agradeceré su apoyo en la construcción de una macro, que de como resultado un solo registro.
Lo que yo hago manualmente es lo siguiente: Primero agrupo por nombre de trabajador, luego evalúo si es del mismo tipo de planilla, luego si es del mismo tipo de trabajador y finalmente si la fecha de contrato es continua, de ser así, sería el resultado de un solo registro.
Todos los datos de la Hoja "CONTRATOS" deben pasar también a la hoja "SALIDA" en el mismo orden que están registrados en la hoja "CONTRATOS" y todo debe quedar como esta en la hoja de "SALIDA". Pueden haber celdas vacías pero en su oportunidad se llenara con sus datos y estas deben pasar a la hoja de "SALIDA". Como son: DNI, CONSUP, ÁREA, FEC NACIMIENTO, ETC. Creo que aquí no hay nada que evaluar, más que llevar los datos de una hoja a otra.
MAXIMOP.
Te anexo la macro actualizada
Sub Registro_Por_Contrato()
'
' Por Dante Amor
'
'
Application.ScreenUpdating = False
Set h1 = Sheets("contratos")
Set h2 = Sheets("salida")
h2.Rows("2:" & Rows.Count).Clear
'
Call Ordenar(h1)
'
ant1 = h1.Cells(2, "R") & "|" & h1.Cells(2, "D") & "|" & h1.Cells(2, "F")
finicio = h1.Cells(2, "S")
fcese = finicio - 1
meses = 0
j = 2
For i = 2 To h1.Range("R" & Rows.Count).End(xlUp).Row + 1
registra = False
If ant1 = h1.Cells(i, "R") & "|" & h1.Cells(i, "D") & "|" & h1.Cells(i, "F") Then
If h1.Cells(i, "S") - 1 = fcese Then
meses = meses + h1.Cells(i, "X")
Else
registra = True
End If
Else
registra = True
End If
If registra Then
'registra contrato
h1.Rows(i - 1).Copy h2.Rows(j)
'datos = Split(ant1, "|")
'h2.Range(h2.Cells(j, "A"), h2.Cells(j, "C")) = datos
'
h2.Cells(j, "S") = finicio
h2.Cells(j, "V") = fcese
h2.Cells(j, "X") = meses
finicio = h1.Cells(i, "S")
meses = h1.Cells(i, "X")
j = j + 1
End If
ant1 = h1.Cells(i, "R") & "|" & h1.Cells(i, "D") & "|" & h1.Cells(i, "F")
fcese = h1.Cells(i, "V")
Next
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
'
Sub Ordenar(h1)
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u = h1.Range("R" & Rows.Count).End(xlUp).Row
With h1.Sort
'
.SortFields.Clear
'nombre
.SortFields.Add Key:=h1.Range("R2:R" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'planilla
.SortFields.Add Key:=h1.Range("D2:D" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'tipo
.SortFields.Add Key:=h1.Range("F2:F" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'fec ini
.SortFields.Add Key:=h1.Range("S2:S" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'fec cese
.SortFields.Add Key:=h1.Range("V2:V" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'
.SetRange h1.Range("A1:BM" & u): .Header = xlYes: .MatchCase = False
.Orientation = xlTopToBottom: .SortMethod = xlPinYin: .Apply
End With
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
