Jump to content

Archived

This topic is now archived and is closed to further replies.

Visor

Resumir a valores únicos y calcular

Recommended Posts

Estimados amigos del foro, les saludo cordialmente

Me gustaría saber como podría a partir de una lista de nombres de materias armar otra lista con nombres únicos y haber contado cada nombre y de esto calcular el porcentaje con macros. He intentado pero me base en un código que incluye input y mejor quisiera evitar esto,.... algo he conseguido pero me parece que es muy empírico no como lo técnico como ustedes saben hacerlo.

Me gustaría se apoyado en este tema

subo el archivo para que lo vean

Gracias anticipadas

Resumir sin duplicado y calcular.xlsm

Share this post


Link to post
Share on other sites

Buenas @Visor

Utiliza

Sub getUnicosAndCount()
    Dim u As Long
    Dim c As Long
    Application.ScreenUpdating = False
' TOMAR LA ÚLTIMA FILA USADA
    u = Hoja2.Range("B" & Hoja2.Rows.Count).End(xlUp).Row
' SI ES MENOR A 3 ES QUE NO HAY DATOS
    If u < 4 Then Exit Sub
' SE ABRE LA PROPIEDAD DE LA HOJA
    With Hoja2
' SE LIMPIAN LOS DATOS
        .Range("E:G").EntireColumn.Delete
' SE ABRE PROPIEDADES DEL RANGO A FILTARA
        With .Range("B3:B" & u)
' SE TOMA EL NÚMERO DE ELEMENTOS
            c = .Rows.Count
' SE FILTRAN VALORES ÚNICOS
            .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
' SE COPIA EL RANGO
            .Copy
        End With
' SE COLOCA EL RESULTADO
        .Range("E3").PasteSpecial
' SE LIMPIA LA MEMORIA
        Application.CutCopyMode = False
' SE RETIRA EL FILTRO
        .ShowAllData
' SE TOMA EL NÚMERO DE ELEMENTOS OPTENIDOS
        u = .Range("E" & .Rows.Count).End(xlUp).Row
' SI ES MENOR A 4 ES QUE NO SE LOGRO NINGUNO
        If u < 4 Then Exit Sub
' SE ABRE PROPIEDADES DEL RANGO INICAL RESULTADO
        With .Range("E3:G3")
' SE COLOCA LOS TITULOS
            .Value = Array("Materia", "Cuenta", "%")
' SE DA FORMATO TAMAÑO, NEGRITA Y COLOR FONDO
            .Font.Size = 12
            .Font.Bold = True
            .Interior.Color = 65535
        End With
' SE COLOCA LA FORMULA PARA EL NÚMERO DE CADA ELEMENTO
        With .Range("F4:F" & u)
            .FormulaR1C1 = "=COUNTIF(C[-4],RC[-1])"
            .Value = .Value
        End With
' SE COLOCA LA FORMULA PARA EL PROCENTAJE DE CADA ELEMENTO
        With .Range("G4:G" & u)
            .FormulaR1C1 = "=RC[-1]/" & c
            .Value = .Value
            .NumberFormat = "0.00%"
        End With
' SE COLOCA TEXTO Y DA FORMATO AL RESUMEN
        With .Range("F" & u + 1 & ":G" & u + 1)
            .Value = Array(c, 1)
            .Font.Size = 12
            .Font.Bold = True
        End With
        .Range("G" & u + 1).NumberFormat = "0.00%"
' SE LE DA AUTO ANCHO A LAS COLUMNAS RESULTADO
        .Columns("E:G").Columns.AutoFit
' SE ORDENA EL RANGO RESULTADO
        .Range("E4:G" & u).Sort key1:=.Range("E4"), order1:=xlAscending
    End With
' SE LANZA MENSAJE FINALIZACIÓN
    MsgBox "FINALIZADO PROCESO", vbInformation, Application.OrganizationName
End Sub

Un saludo

Share this post


Link to post
Share on other sites

Quedo muy agradecido, Realmente son geniales, sabia que no era tan sencillo. con el código no dependo de inputs sobre todo no me dejaba colocar un rango solo me dejaba colocar por ejemplo B:B (toda la columna).

Ambas soluciones se ven técnicamente de maestros.

Esto me sirve para cualquier análisis de frecuencia. Quedo muy agradecido a los dos

Logroastur los temas que has colocado me han ayudado a comprender las razones del código que has puesto, lo del ancho de columnas no lo habia visto antes. Gracias

Claro que la suma total de la cuenta no coincide por lo tanto los porcentajes fallan, pero creo que veré donde pueda corregirle

Tema solucionado

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.

INFORMACIÓN BÁSICA SOBRE PROTECCIÓN DE DATOS

Responsable: Sergio Andrés Celemín

Finalidad: Moderar y responder comentarios de usuarios. Recuerda que la información que facilites es pública, y los datos que incluyas los leerá cualquier visitante de esta web, así como el avatar que poseas.

Legitimación: Consentimiento del interesado.

Destinatarios: Hetzner Online GmbH.

Derechos: Puedes ejercitar en cualquier momento tus derechos de acceso,
rectificación, supresión, oposición y demás derechos legalmente establecidos a
través del email sergio@ayudaexcel.com.

Información adicional: Encontrarás más información en la política de privacidad.




×
×
  • Create New...

Important Information

Privacy Policy