Es un gusto saludarles y solicitarles su apoyo en lo siguiente.
Hace un tiempo obtuve el apoyo de @JSDJSD para una macro que agrega una fila de totales y subtotales en la hoja CUADRO. En esta hoja se importa información de la hojas DATOS. En la actualidad me funciona bien, en la hoja CUADRO cuenta con 2 columnas denominadas DAP y VOLUMEN. Al final se suman los totales, pero mi deseo es que en la fila Total aparezca la Suma de VOLUMEN (que lo hace muy bien), pero en la columna DAP, obtenga el PROMEDIO de las filas SUBTOTALES, que es lo que aún no logro modificar.
Si pudieran apoyarme, se los agradecería.
La macro es esta:
Sub EXTRAER()
With Hoja2
For x = .Range("D" & Rows.Count).End(xlUp).Row To 5 Step -1
If .Cells(x, 4) = "SUBTOTAL" Or .Cells(x, 4) = "TOTAL" Then
.Range("D" & x).EntireRow.Delete
End If
Next x
Hoja1.Range("A1", "E" & Hoja1.Range("E" & Rows.Count).End(xlUp).Row).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("C4:D4"), Unique:=True
.Sort.SortFields.Clear
.Range("c4", "d" & .Range("D" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("C4"), _
Key2:=.Range("D4"), Header:=xlYes, Order1:=xlAscending, Order2:=xlAscending
.Range("C5:C" & .Range("C" & Rows.Count).End(xlUp).Row).AdvancedFilter 2, , .Range("O5"), 1
.Range("O:O").Sort Key1:=.Columns("O"), Order1:=xlAscending, Header:=xlYes
linea = 5
For cont = 3 To .Range("O" & Rows.Count).End(xlUp).Row
buscado1 = .Cells(cont, 15)
For Each buscado In .Range("C" & linea, "C" & .Range("C" & Rows.Count).End(xlUp).Row + 1)
If buscado = buscado1 Then
Else
.Rows(buscado.Row).Insert
.Cells(buscado.Row - 1, 4) = "SUBTOTAL"
.Range("D" & buscado.Row - 1).Font.Bold = True
.Range("E" & buscado.Row - 1).Font.Bold = True
.Range("F" & buscado.Row - 1).Font.Bold = True
.Cells(buscado.Row - 1, 6) = Application.WorksheetFunction.Sum(.Range("F" & linea, "F" & buscado.Row - 1))
.Cells(buscado.Row - 1, 5) = Round(Application.WorksheetFunction.Average(.Range("E" & linea, "E" & buscado.Row - 1)), 2)
acumulado = acumulado + CDbl(.Cells(buscado.Row - 1, 6))
acumulado1 = acumulado1 + CDbl(.Cells(buscado.Row - 1, 5))
linea = buscado.Row
Exit For
End If
Next
Next cont
.Range("D" & linea) = "TOTAL"
.Range("D" & linea).Font.Bold = True
.Range("E" & linea) = acumulado1
.Range("E" & linea).Font.Bold = True
.Range("F" & linea) = acumulado
.Range("F" & linea).Font.Bold = True
.Range("O:O").Columns.Delete
End With
End Sub
Buena noche foristas.
Es un gusto saludarles y solicitarles su apoyo en lo siguiente.
Hace un tiempo obtuve el apoyo de @JSDJSD para una macro que agrega una fila de totales y subtotales en la hoja CUADRO. En esta hoja se importa información de la hojas DATOS. En la actualidad me funciona bien, en la hoja CUADRO cuenta con 2 columnas denominadas DAP y VOLUMEN. Al final se suman los totales, pero mi deseo es que en la fila Total aparezca la Suma de VOLUMEN (que lo hace muy bien), pero en la columna DAP, obtenga el PROMEDIO de las filas SUBTOTALES, que es lo que aún no logro modificar.
Si pudieran apoyarme, se los agradecería.
La macro es esta:
Sub EXTRAER() With Hoja2 For x = .Range("D" & Rows.Count).End(xlUp).Row To 5 Step -1 If .Cells(x, 4) = "SUBTOTAL" Or .Cells(x, 4) = "TOTAL" Then .Range("D" & x).EntireRow.Delete End If Next x Hoja1.Range("A1", "E" & Hoja1.Range("E" & Rows.Count).End(xlUp).Row).AdvancedFilter _ Action:=xlFilterCopy, CopyToRange:=.Range("C4:D4"), Unique:=True .Sort.SortFields.Clear .Range("c4", "d" & .Range("D" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("C4"), _ Key2:=.Range("D4"), Header:=xlYes, Order1:=xlAscending, Order2:=xlAscending .Range("C5:C" & .Range("C" & Rows.Count).End(xlUp).Row).AdvancedFilter 2, , .Range("O5"), 1 .Range("O:O").Sort Key1:=.Columns("O"), Order1:=xlAscending, Header:=xlYes linea = 5 For cont = 3 To .Range("O" & Rows.Count).End(xlUp).Row buscado1 = .Cells(cont, 15) For Each buscado In .Range("C" & linea, "C" & .Range("C" & Rows.Count).End(xlUp).Row + 1) If buscado = buscado1 Then Else .Rows(buscado.Row).Insert .Cells(buscado.Row - 1, 4) = "SUBTOTAL" .Range("D" & buscado.Row - 1).Font.Bold = True .Range("E" & buscado.Row - 1).Font.Bold = True .Range("F" & buscado.Row - 1).Font.Bold = True .Cells(buscado.Row - 1, 6) = Application.WorksheetFunction.Sum(.Range("F" & linea, "F" & buscado.Row - 1)) .Cells(buscado.Row - 1, 5) = Round(Application.WorksheetFunction.Average(.Range("E" & linea, "E" & buscado.Row - 1)), 2) acumulado = acumulado + CDbl(.Cells(buscado.Row - 1, 6)) acumulado1 = acumulado1 + CDbl(.Cells(buscado.Row - 1, 5)) linea = buscado.Row Exit For End If Next Next cont .Range("D" & linea) = "TOTAL" .Range("D" & linea).Font.Bold = True .Range("E" & linea) = acumulado1 .Range("E" & linea).Font.Bold = True .Range("F" & linea) = acumulado .Range("F" & linea).Font.Bold = True .Range("O:O").Columns.Delete End With End Sub
Adjunto el archivo de ejemplo.
EJEMPLO FILTRO.xlsm