Como Separar por grupos y sumarlos con Macros

Respuesta de
a
Avatar
Usuario

Buenas tardes, tengo un reporte donde un ítem puede repetirse "n" cantidad de veces, quisiera a través de una macro, separar por items cada grupo y totalizar la columna de la derecha, insertando un salto de pagina entre cada grupo.

 

Ejemplo:

En la columna A van todos los códigos

en la columna B van los importes.

 

A120    200

A120    200

A120    200

A120    200

Total A120    800:

Salto de pagina

_________________________________________

 

Salto de pagina

N700    300

N700    300

TOTAL N700   600

 

Por la ayuda a brindar.. gracias..

Avatar
Experto

Hola:

Te preparo la macro y te la envío

saludos.DAM

Avatar
Experto

Hola:

En la "Hoja1" debes tener tus dato y Con la siguiente macro te pone el resultado en la "Hoja2"

Si tus hojas se llaman diferente, cambia en la macro en estas líneas los nombres de tus hojas.

Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")

 

Sigue las Instrucciones para un botón y ejecutar la macro
1. Abre tu libro de Excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Ahora para crear un botón, puedes hacer lo siguiente:
6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona Asignar macro / Selecciona:  subtotales
9. Aceptar.
10. Para ejecutarla dale click a la imagen.

Sub subtotales()
'Por.DAM
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
h2.ResetAllPageBreaks
h2.Cells.Clear
h1.Select
h1.Rows(1).EntireRow.Copy h2.Range("A1")
    c = "A"
    ant = h1.Range(c & 2)
    j = 2
    uf = h1.Range(c & Rows.Count).End(xlUp).Row
    For i = 2 To uf + 1
        If ant = h1.Cells(i, c) Then
            h1.Rows(i).EntireRow.Copy h2.Range("A" & j)
            j = j + 1
        Else
            h2.Range("A" & j) = "Total " & ant
            h2.Range("B" & j) = tot
            j = j + 1
            h2.HPageBreaks.Add Before:=h2.Range("A" & j)
            tot = 0
            h1.Rows(i).EntireRow.Copy h2.Range("A" & j)
            j = j + 1
        End If
        tot = tot + h1.Cells(i, "B")
        ant = Cells(i, c)
    Next
h2.Select
MsgBox "Proceso Terminado", vbInformation, "AGRUPAR"
End Sub
 

 Saludos.DAM
Si es lo que necesitas, por favor, podrías finalizar la pregunta. Gracias

 

Avatar
Usuario

Hola Dam:

En primer lugar te agradezco tu ayuda con la macro elaborada, cuando la corro, en el caso del primer grupo, por ejemplo este:

A120 200
A120 200
A120 200
A120 200
Total A120 800:

 

Solo me suma hasta la tercera fila, dando como resultado 600, siendo lo correcto 800, al parecer esto sucede solo con el primer grupo, de ahí el resto todo bien..

 

Consulto si es posible comentarme el código utilizado, y lo otro es que en la parte donde dice Total A120, me coloque la cuenta de los items que lleva ese grupo.

Por ejemplo: Total A120 ( 04 ) $800.00

 

Gracias, nuevamente

Avatar
Experto

Hola:

La macro consideraba que tenías en la fila 1 un encabezado, por eso empieza a contar en la fila 2, pero ya lo corregí, ahora empieza a contar en la  fila 1.

Cambia la macro por esta.

Sub subtotales()
'Por.DAM
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
h2.ResetAllPageBreaks
h2.Cells.Clear
h1.Select
h1.Rows(1).EntireRow.Copy h2.Range("A1")
    c = "A"
    ant = h1.Range(c & 2)
    j = 2
    uf = h1.Range(c & Rows.Count).End(xlUp).Row
    For i = 1 To uf + 1
        If ant = h1.Cells(i, c) Then
            h1.Rows(i).EntireRow.Copy h2.Range("A" & j)
            j = j + 1
        Else
            h2.Range("A" & j) = "Total " & ant & " ( " & Format(con, "#00") & " )"
            h2.Range("B" & j) = Format(tot, "$ #,#00.00")
            j = j + 1
            h2.HPageBreaks.Add Before:=h2.Range("A" & j)
            tot = 0
            con = 0
            h1.Rows(i).EntireRow.Copy h2.Range("A" & j)
            j = j + 1
        End If
        tot = tot + h1.Cells(i, "B")
        con = con + 1
        ant = Cells(i, c)
    Next
h2.Select
MsgBox "Proceso Terminado", vbInformation, "AGRUPAR"
End Sub
 

 

 Generalmente entrego una solución por pregunta, si la consulta es más complicada o ya no es representativa a la pregunta original, te pediría de favor que finalices esta pregunta. Crea una nueva pregunta y con todo gusto te explico el código.

 

Saludos.DAM

Avatar
Usuario

Gracias por la aclaración y por la ayuda brindada, doy por finalizada esta consulta