Enumerar y contar los 4 primeros registros mayores de una base de datos con macros
Tengo una consulta como puedo hacer que mediante una base datos de mi hoja "Datos" al momento de darle click en consolidar me procese los 4 primeros registros enumerados y con su cuenta de datos y su porcentaje con macros asi como se muestra en la esta imagen.
Hoja Resultado.
Y esta es la hoja de la base de datos la cual puede ir aumentando disminuyendo los registros simultáneamente.
1 Respuesta
Respuesta de James Bond
1
Este es el resultado de la macro
y esta es la macro
Sub crear_tabla()
Set H1 = Worksheets("datos")
Set H2 = Worksheets("resultados")
H2.Cells.Clear
Set DATOS = H1.Range("a2").CurrentRegion
With DATOS
filas = .Rows.Count - 1
Set DATOS = .Rows(2).Resize(filas)
DATOS.Copy: H2.Range("a2").PasteSpecial
End With
Set RESULTADO = H2.Range("a2").CurrentRegion
With RESULTADO
.Columns(2).EntireColumn.Delete
Set RESULTADO = .CurrentRegion
.RemoveDuplicates Columns:=2
Set RESULTADO = .CurrentRegion
filas = .Rows.Count
For I = 1 To filas
nombre = .Cells(I, 2)
cuenta = WorksheetFunction.CountIf(DATOS.Columns(3), nombre)
.Cells(I, 3) = cuenta
Next I
Set RESULTADO = .CurrentRegion
.Sort key1:=Range(.Columns(3).Address), order1:=xlDescending
diferencia = filas - 4
.Rows(filas - diferencia + 1).Resize(diferencia).Clear
Set RESULTADO = .CurrentRegion
suma = WorksheetFunction.Sum(.Columns(3))
.Columns(4).Formula = "=sum(" & .Cells(3).Address(0, 0) & "/" & suma & ")"
.Columns(4).NumberFormat = "00.00%"
.Cells(.Rows.Count + 1, 2) = "TOTAL"
.Cells(.Rows.Count + 1, 3) = suma
.Cells(.Rows.Count + 1, 4) = WorksheetFunction.Sum(.Columns(4))
.Cells(1, 4).Rows(.Rows.Count + 1).NumberFormat = "00.00%"
.Cells(1, 1) = 1
.Cells(1, 1).AutoFill Destination:=Range(.Columns(1).Address), Type:=xlFillSeries
Set RESULTADO = .CurrentRegion
.Rows(.Rows.Count).Interior.ColorIndex = 15
.Rows(.Rows.Count).Font.Bold = True
With RESULTADO.Rows(0)
.Value = Array("No", "NOMBRES", "CANT.", "%")
.Interior.ColorIndex = 15
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set DATOS = Nothing: Set RESULTADO = Nothing
Set H1 = Nothing: Set H2 = Nothing
End Sub
