Separar Insertar Fila y sumar-Multiplicar datos
Reciban un cordial saludo
Me gustaría que me apoyaran con una macro para hacer lo siguiente
Tengo alrededor de 25 a 30 columnas con datos y filas es variable como unas 1000, los datos los debo ordenar por departamento e ir al encabezado de la columna si dice "SI" entonces suma y multiplica por 2% y así sucesivamente en cada columna, ejemplo
ColA ColB ColC ColD ColE ColF ColX
SI SI SI SI
Id Depto Importe1 Importe2 Importe3 importe4 ... Importe 20
1 Finanzas 100 300 500 20 50
12 Ventas 40 10 1000 800 5000
3 Compras 100 100 100 100 1000
A1 Ventas 200 40 200 2000 0
20Q Finanzas 25 0 0 100 50
Despues de correr la macro deberia quedar asi
1 Finanzas 100 300 500 20 50
20Q Finanzas 25 0 0 100 50
total 2.5 N/A 10 2.4 2
12 Ventas 40 10 1000 800 5000
A1 Ventas 200 40 200 2000 0
total 4.8 N/A 24 56 100
3 Compras 100 100 100 100 1000
total 2 N/A 2 2 20
Agradezco de antemano sus comentarios y apoyo
Saludos
1 respuesta
Si los "SI" están en la fila 1, los títulos en la fila 2 y los datos empiezan en la fila 3, utiliza la siguiente macro.
Sub sumar_multiplicar()
'Por.DAM
Set h1 = ActiveSheet
c = h1.Cells(2, Columns.Count).End(xlToLeft).Column
u = h1.Range("B" & Rows.Count).End(xlUp).Row
With h1.Sort
.SortFields.Clear: .SortFields.Add Key:=h1.Range("B3:B" & u)
.SetRange h1.Range(h1.Cells(2, 1), h1.Cells(u, c)): .Header = xlYes: .Apply
End With
fin = u
ant = h1.Cells(u, "B")
h1.Cells(u + 1, "B") = "Total"
For i = u To 2 Step -1
If ant <> h1.Cells(i, "B") Then
For j = 3 To c
If h1.Cells(1, j) = "SI" Then
s = Application.Sum(h1.Range(h1.Cells(i + 1, j), h1.Cells(fin, j)))
h1.Cells(fin + 1, j) = s * 0.02
Else
h1.Cells(fin + 1, j) = "N/A"
End If
Next
If i > 2 Then
h1.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
h1.Cells(i + 1, "B") = "Total"
fin = i
End If
End If
ant = h1.Cells(i, "B")
Next
MsgBox "Separar Insertar Fila y sumar-Multiplicar datos", vbInformation, "Proceso Terminado"
End SubSaludos.Dante Amor
Recuerda valorar la respuesta
