Totalizar 2 columnas para terminar informe con macros
Necesito terminar un informe con macros y me falta totalizar 2 columnas.
Un tercer registro a crear sería generar un cálculo entre los 2 columna totalizadas.
Se debe crear una línea con el Total de haberes (suma el importe total de haberes). El totalizador debe estar una línea debajo del último registro de los haberes.
Se debe crear una línea con el Total de descuentos (suma el importe total de descuentos). El totalizador debe estar una línea debajo del último registro de los descuentos.
Finalmente se crea una línea con el Liquido (Total haberes - Total descuentos). El totalizador debe estar una línea debajo de Total Haberes.
Estos totalizadores irán variando de posición según el número de registros a totalizar.
Ojalá los conceptos creados vengan con negrita.
1 Respuesta
Te anexo la macro completa para totalizar
Sub Reporte()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Base")
Set h2 = Sheets("Variables")
Set h3 = Sheets("Reporte")
'
u3 = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
h3.Range("A2:G" & u3).ClearContents
'
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
existe = False
Set r = h2.Columns("C")
Set b = r.Find(h1.Cells(i, "D"), lookat:=xlWhole)
If Not b Is Nothing Then
ncell = b.Address
Do
'detalle
If h2.Cells(b.Row, "A") = h1.Cells(i, "A") Then
existe = True
wvar = h2.Cells(b.Row, "E")
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
'
If existe Then
If wvar = "H" Then
Set b = h3.Range("A:A").Find(h1.Cells(i, "D"), lookat:=xlWhole)
If Not b Is Nothing Then
h3.Cells(b.Row, "C") = h3.Cells(b.Row, "C") + h1.Cells(i, "H")
Else
u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h3.Cells(u, "A") = h1.Cells(i, "D")
h3.Cells(u, "B") = h1.Cells(i, "E")
h3.Cells(u, "C") = h1.Cells(i, "H")
End If
wtoth = wtoth + h1.Cells(i, "H")
ElseIf wvar = "D" Then
Set b = h3.Range("E:E").Find(h1.Cells(i, "D"), lookat:=xlWhole)
If Not b Is Nothing Then
h3.Cells(b.Row, "G") = h3.Cells(b.Row, "G") + (h1.Cells(i, "H") * -1)
Else
u = h3.Range("E" & Rows.Count).End(xlUp).Row + 1
h3.Cells(u, "E") = h1.Cells(i, "D")
h3.Cells(u, "F") = h1.Cells(i, "E")
h3.Cells(u, "G") = h1.Cells(i, "H") * -1
End If
wtotd = wtotd + h1.Cells(i, "H") * -1
End If
End If
End If
Next
'
u = h3.Range("A" & Rows.Count).End(xlUp).Row
With h3.Sort
.SortFields.Clear: .SortFields.Add Key:=h3.Range("A2:A" & u)
.SetRange h3.Range("A1:C" & u): .Header = xlYes: .Apply
End With
'
h3.Cells(u + 2, "B") = "TOTAL HABERES"
h3.Cells(u + 4, "B") = "LIQUIDO"
h3.Cells(u + 2, "C") = wtoth
h3.Cells(u + 4, "C") = wtoth - wtotd
u = h3.Range("E" & Rows.Count).End(xlUp).Row
'
With h3.Sort
.SortFields.Clear: .SortFields.Add Key:=h3.Range("E2:E" & u)
.SetRange h3.Range("E1:G" & u): .Header = xlYes: .Apply
End With
'
h3.Cells(u + 2, "f") = "TOTAL DESCUENTOS"
h3.Cells(u + 2, "G") = wtotd
'
Application.ScreenUpdating = True
h3.Select
MsgBox "Reporte terminado", vbInformation
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
