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.

1 Respuesta

Respuesta
1

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

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas