Macro en excel insertar filas y sumas de rangos duplicados
Tengo una base de datos con muchas filas (alrededor de 6,000) y quiero saber si hay una macro que pueda hacer lo siguiente:
A B C
1 AB22 5 12
2 AB22 6 19
3 AB22 8 13
4 AB22 5 7
..........................................
5 AB22 8 51 <<<---Esto es lo que se desea!
De la tabla anterior, se espera que en la fila 5 arroje lo siguiente:
1. ¿Insertar 1 fila debajo de valores duplicados de la columna A (como en el ejemplo estaría en la fila 5)?
2. Que en la celda de la fila nueva de esta columna, coloque únicamente el valor anterior que estaba duplicado.
3. De la columna B, me arroje el valor máximo de este rango anteriormente duplicado y,
4. De la columna C, sume los valores de los duplicados de la columna A.
Y así para cada uno de los valores duplicados.
1 respuesta
¡Gracias! ¡Gracias! Los duplicados vienen juntos y ordenandos, aunque en ese orden también aparecen valores únicos, es decir: AB22, AB22, AB22, AB23, AB24, AB25, AB25, AB25, etc.
Gracias por la respuesta. Ojalá se pueda!
Si se puede... pero no debes valorar antes de recibir la respuesta ... quizás ahora con la macro merezca una mejor valoración :)
Coloca en un módulo esta subrutina, ajustá el nro de la fila inicial que dejé en 1 y quitale la línea de la marca X que solo dejé para poder visualizar los subtotales:
Sub ContarRepetidos()
'x Elsamatilde
'se recorre la col A hasta encontrar celda vacía = fin de rango
[A1].Select
ini = 1
While ActiveCell <> ""
'se guarda el 1er valor y fila de inicio para comparar
dato = ActiveCell
totx = totx + ActiveCell.Offset(0, 2)
'se compara con celda siguiente
If ActiveCell.Offset(1, 0) <> dato Then
'guarda la ultima fila del rango
fini = ActiveCell.Row
'inserta fila para colocar subtotales
ActiveCell.Offset(1, 0).EntireRow.Insert xlDown
ActiveCell.Offset(1, 0).Select
ActiveCell = dato
ActiveCell.Offset(0, 1) = Application.WorksheetFunction.Max(Range("B" & ini & ":B" & fini))
ActiveCell.Offset(0, 2) = totx
ActiveCell.Offset(0, 3) = "X" 'quitar
totx = 0: ini = ActiveCell.Row + 1
End If
'pasa a la fila sgte
ActiveCell.Offset(1, 0).Select
Wend
MsgBox "Fin del proceso"
End SubSi esta respuesta resuelve tu consulta agradeceré modifiques tu valoración.
Sdos!
