Macro para sumar rango según criterios idénticos
Para mi genio de las macros Dante Amor
Dispongo de una tabla de datos el cual un tercero esta asociado a otro tercero, el cual el tercero último se puede repetir n veces, es decir hay dos o más compañías telefónicas de la cual se cada una tiene sus afiliados o usuarios. La pregunta es como a través de una macro sumar un rango de filas donde hay registros iguales. Para el ejemplo de la imagen es consolidar la suma de la columna F según las coincidencias de la columna D., y que esta operación se registre en una hoja nueva como se muestra en la siguiente imagen:
Espero haberme hecho entender, y de antemano agradezco el tiempo y el deseo de compartir sus conocimientos de una manera tan profesional como lo hace mi amigo Dante Amor y los demás expertos que siempre están muy pro activos para ayudar a solucionar.
1 respuesta
[H o l a estimado, gracias por los elogios.
Lo anterior lo puedes realizar con una tabla dinámica.
Prueba lo siguiente, selecciona el rango de tus datos, en el Menú selecciona Insertar, Tabla Dinámica, Tabla Dinámica, en la ventana de "Lista de campos de tabla dinámica", marca las casillas de los campos ID2, Nombre y Valor:
En las opciones al momento de crear la tabla dinámica, puedes seleccionar una rango en la misma hoja o en una hoja nueva.
Revisa si es lo que necesitas, de lo contrario avísame y te creo la macro.
Hola Dante, si con tabla dinámica lo he realizado, la pero se puede realizar con vba ?
Te anexo la macro. Pon tus datos en la "Hoja1", el resultado quedará en la "Hoja2"
Sub sumar()
'Por Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
h2.Cells.ClearContents
h1.[D1:F1].Copy h2.[B1]
h2.[A1] = "REG"
'
r = 1
For i = 2 To h1.Range("D" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("B").Find(h1.Cells(i, "D").Value, lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(b.Row, "D").Value = h2.Cells(b.Row, "D").Value + h1.Cells(i, "F").Value
Else
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u2, "A").Value = r
h2.Cells(u2, "B").Value = h1.Cells(i, "D").Value
h2.Cells(u2, "C").Value = h1.Cells(i, "E").Value
h2.Cells(u2, "D").Value = h1.Cells(i, "F").Value
r = r + 1
End If
Next
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
