Macro Calculo Totales en Valores Absolutos y Relativos %

Para DAM

Se requiere macro que sume por filas y coloque su resultado total en valores absolutos y en valor relativos (%). Anexo ejemplo de los resultados en negrilla, resultados por macros

Gracias,

2

2 respuestas

Respuesta
1

Te anexo la macro

Sub Macro1()
'Por.Dante Amor
    ut = Range("A" & Rows.Count).End(xlUp).Row
    u1 = Range("A" & Rows.Count).End(xlUp).Row - 1
    'Sumas
        Range("I3:I" & u1).FormulaR1C1 = "=SUM(RC3:RC6)"
        Range("J3:J" & u1).FormulaR1C1 = "=RC[-1]/R" & ut & "C9"
    'Total
        Range("I" & ut).FormulaR1C1 = "=SUM(R3C:R" & u1 & "C)"
        Range("J" & ut).FormulaR1C1 = "=SUM(R3C:R" & u1 & "C)"
End Sub

No comentaste cuáles fórmulas van en absoluto y cuáles en relativo. Pero supongo que las sumas de las columnas I y J son relativas, ya que la fila va cambiando. Mientras que los totales podrían ser absolutas, una vez que se ha calculado el número de filas.

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Respuesta

Prueba esta macro es dinámica se adapta a los datos si quitas o añades datos la naxro se adaptara a estos cambios.

 Sub ESTADISTICAS()

Set DATOS = Range("A2").CurrentRegion

With DATOS
Set DATOS = .Rows(2).Resize(.Rows.Count - 1)
.Rows(.Rows.Count + 3).Formula = "=SUM(" & .Columns(1).Address(False, False) & ")"
.Cells(.Rows.Count + 2, 1) = "NO. REGISTROS"
.Cells(.Rows.Count + 2, 1).Font.Bold = True
.Cells(.Rows.Count + 3, 2) = .Rows.Count
Set DATOS = .Columns(3)
Set CANTIDADES = .Columns(.Columns.Count + 2).CurrentRegion
End With

With CANTIDADES
Set CANTIDADES = .Rows(2).Resize(.Rows.Count - 1)
.Cells(.Rows.Count + 2, 1) = "NO. REGISTROS"
.Cells(.Rows.Count + 2, 1).Font.Bold = True
.Rows(.Rows.Count + 3).Formula = "=SUM(" & .Columns(1).Address(False, False) & ")"
Set TOTALES = .Columns(.Columns.Count + 2).CurrentRegion
End With

With TOTALES

Set TOTALES = .Rows(2).Resize(CANTIDADES.Rows.Count, 2)
.ClearContents
.Columns(1).Formula = "=SUM(" & CANTIDADES.Rows(1).Address(False, False) & ")" & "+" & _
DATOS.Cells(1, 1).Address(False, False)
SUMA = WorksheetFunction.Sum(.Columns(1))
.Columns(2).Formula = "=" & .Cells(1, 1).Address(False, False) & "/" & SUMA
.Cells(.Rows.Count + 2, 1) = "NO. REGISTROS"
.Cells(.Rows.Count + 2, 1).Font.Bold = True
.Rows(.Rows.Count + 3).Formula = "=SUM(" & .Columns(1).Address(False, False) & ")"
End With
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas