Facilitar macro vba registrar por contrato
[Hola
Dante buenos días por favor facilitarme el archivo que me suena interesante
Extraer un registro de Varios Contratos
Email: [email protected]
s a l u d o s
1 Respuesta
Respuesta de Dante Amor
1
Va la macro para la respuesta
Sub Registro_Por_Contrato()
'
' Por Dante Amor
'
'
Application.ScreenUpdating = False
Set h1 = Sheets("contratos")
Set h2 = Sheets("resultado")
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
datos = Split(ant1, "|")
h2.Range(h2.Cells(j, "A"), h2.Cells(j, "C")) = datos
h2.Cells(j, "D") = finicio
h2.Cells(j, "E") = fcese
h2.Cells(j, "F") = 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 SubTe anexo el archivo con datos de ejemplo
Sal u dos
