Calcular estadísticos al seleccionar un dato desde un combobox

Tengo un formulario que me ayudó el experto Andy Machín que está muy excelente su algoritmo, lo que deseo es que cuando seleccione para buscar desde el combobox Profesión y busque una determinada profesion y cuando busque lo datos en el lisbox, en este caso lo hice por Psicología, que el Frame(Estadística) me arroje los siguientes resultados:

Cantidad de Aprobados: 3

Cantidad de Desaprobados: 2

Nota máxima de Aprobados: 15

Nota mínima de Aprobados: 12

Nota máxima de Desaprobados: 9

2 Respuestas

Respuesta
1

Este es el resultado de la macro

y esta es la macro, la carga de datos se hace a través de un rowsource y maneja instrucciones name para guardar parte de la información dentro de la hoja y poder usarla en otras partes del programa a manera de matriz de datos, si tu macro carga instrucciones diferentes puede entrar en conflicto con esta macro y dar errores

Private Sub ComboBox1_Change()
Set LISTA = Range("LISTA")
INDICE = ComboBox1.ListIndex
If INDICE < 0 Then
With ListBox1
        .RowSource = LISTA.Address
        .ColumnHeads = True
        .ColumnCount = LISTA.Columns.Count
    End With
        GoTo FIN
End If
PROFESION = ComboBox1.Value
COL = LISTA.Columns.Count
Range("K1").CurrentRegion.Clear
For Each Control In UserForm1.Controls
    NOMBRE = UCase(TypeName(Control))
    If NOMBRE = "TEXTBOX" Then Control.Text = Empty
Next Control
With ActiveSheet
        If .AutoFilterMode = True Then .AutoFilterMode = False
End With
With Range("A1")
    .AutoFilter field:=4, Criteria1:=PROFESION
    .CurrentRegion.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Range("K1").PasteSpecial
    .AutoFilter
    Set FILTROS = Range("K1").CurrentRegion
End With
With FILTROS
    FILASF = .Rows.Count
    Set FILTROS = .Rows(2).Resize(FILASF - 1)
    With ListBox1
        .RowSource = Empty
        .RowSource = FILTROS.Address
        .ColumnCount = FILTROS.Columns.Count
        .ColumnHeads = True
    End With
    .Sort _
        KEY1:=Range(.Columns(6).Address), ORDER1:=xlAscending
        ACUENTA = WorksheetFunction.CountIf(FILTROS.Columns(6), "APROBADO")
        If ACUENTA > 0 Then
            AINDICE = WorksheetFunction.Match("APROBADO", FILTROS.Columns(6), 0)
            Set APROBADO = .Rows(AINDICE).Resize(ACUENTA, COL)
            TextBox2.Text = WorksheetFunction.Max(APROBADO.Columns(5))
            TextBox3.Text = APROBADO.Rows.Count
            TextBox4.Text = FILASF - 1
            TextBox5.Text = WorksheetFunction.Min(APROBADO.Columns(5))
        End If
        DCUENTA = WorksheetFunction.CountIf(FILTROS.Columns(6), "NO APROBADO")
        If DCUENTA > 0 Then
            DINDICE = WorksheetFunction.Match("NO APROBADO", FILTROS.Columns(6), 0)
            Set NAPROBADO = .Rows(DINDICE).Resize(DCUENTA, COL)
            TextBox1.Text = WorksheetFunction.Max(NAPROBADO.Columns(5))
            TextBox6.Text = NAPROBADO.Rows.Count
        End If
End With
Set LISTA = Nothing: Set FILTROS = Nothing
Set APROBADO = Nothing: Set NAPROBADO = Nothing
FIN:
End Sub
Private Sub UserForm_Initialize()
Dim UNICOS As New Collection
Set DATOS = Range("A1").CurrentRegion
With DATOS
    FILAS = .Rows.Count
    Set DATOS = .Rows(2).Resize(FILAS - 1)
    With ListBox1
        .RowSource = DATOS.Address
        .ColumnHeads = True
        .ColumnCount = DATOS.Columns.Count
    End With
    For I = 1 To FILAS - 1
        PROFESION = .Cells(I, 4)
        On Error Resume Next
        UNICOS.Add PROFESION, CStr(PROFESION)
        If Err.Number = 0 Then ComboBox1.AddItem PROFESION
        On Error GoTo 0
    Next I
    .Name = "LISTA"
End With
Set LISTA = Nothing: Set DATOS = Nothing
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Range("K1").CurrentRegion.Clear
End Sub

¡Gracias!

Excelente James bond funciona genial, una ultima consulta como se puede hacer para cuando se busque una profesión que solo tenga por ejemplo se presente una persona y no tenga más estadística que sacar me devuelva como valor cero y no vació así.

Cambia esta línea

    If NOMBRE = "TEXTBOX" Then Control.Text = Empty

por esta

    If NOMBRE = "TEXTBOX" Then Control.Text = 0
Respuesta
1

¿Brenda cuál es la lógica detrás de esos datos? ¿Qué significan? ¿Son los mismos para todas las profesiones? Si cada profesión arroja datos diferentes entinces tendrías que decir cuales son. Si cada profesión tiene sus propios parámetros, sera mejor que los agregues en la hoja de "Profesion" para mostrarlos dinámicamente. Más tarde te hago un ejemplo

Ah Brenda, ahora que miro bien la pregunta desde la PC, creo que entiendo qué es cada cosa. Bueno, con el formulario que te hice te sobran dos campos. "Cantidad de aprobados" y "Cantidad de desaprobados"

¿Por qué?

Bueno porque tu puedes filtrar esos criterios y abajo del listbox hay un conteo de registros encontrados.

Por ejemplo, si quieres saber la cantidad de aprobados en PSICOLOGIA, filtras por Profesion PSICOLOGIA, y luego agregas el criterio Condición->APROBADOS y miras el contador.

Así:

Ahí ya sabes cuantos Aprobados hay en Psicología. Si quieres saber los desaprobados, pues cambias la condición a NO APROBADOS. De esta forma ahorras espacio en el formulario y códigos innecesarios.

Ahora, para saber la nota máxima y mínima de aprobados y desaprobados, podemos colocar el resultado del filtro en un Array, y luego encontrar el valor mínimo y máximo dentro del Array, por ahora te lo puedo hacer solo al filtrar por la condición APROBADO y NO APROBADO.

Para hacerlo general, tendrás que decirme cual es la nota mínima para aprobar. Ese dato no lo conozco. Dime, ¿a partir de cuanto es aprobado?

Por ahora tengo este código, hasta que me digas ese detalle. Lo he probado con el Debug. Print y me da la información correctamente.

Dim NotasArr() As Integer
Dim i As Integer, j As Integer
Dim minNota As Integer, maxNota As Integer
Dim strFind As String
    With Evaluacion.ListBox1
        For i = 0 To .ListCount - 1
        strFind = .List(i, 4)
            ReDim Preserve NotasArr(i)
            NotasArr(i) = strFind
        Next i
    End With
minNota = Application.Min(NotasArr)
maxNota = Application.Max(NotasArr)
For j = LBound(NotasArr) To UBound(NotasArr)
    Debug.Print NotasArr(j)
Next j
Debug. Print minNota
Debug. Print maxNota

Gracias por responder Andy Machin,

Bueno las notas para desaprobados son 0-10 y aprobados son 11-20.

Buenos ahora entonces solo quedaría como me explicaste que al buscar por una profesión arroje

Nota máxima de Aprobados: 15 (Aquí yo me puedo saber de sus profesión buscada quien tiene la nota mas alta en tiempo real) 

Nota mínima de Aprobados: 12 (Aquí yo me puedo saber de sus profesión buscada quien tiene la nota mas baja en tiempo real) 

Nota máxima de Desaprobados: 9  (Aquí yo me puedo saber de sus profesión buscada quien tiene la nota mas alta desaprobada en tiempo real y saber quien fue el que quedo debajo del ultimo ganador con la nota aprobada mas baja) 

y sobre la lógica de esto es que aquí se van a controlar muchas personas no solo 5 ni 10 por ejemplo en una profesión pueden presentarse 200 como en algunas 2 o 1 pero en su gran mayoría son muchos y de esta manera desde formulario yo puedo controlar con todos esas estadísticas de aviso que tengo a medida que vaya ingresando los datos y me los vaya mostrando en el lisbox  en tiempo real junto con sus estadísticas.

Por otro lado que pasaría si en una profesión se presentara una sola persona, normal la macro calcularía solo lo que tiene y al resto se le asigna cero.

Brenda, te ajuste el archivo. Revisa la nueva versión y dime si es así como lo necesitas.

Descárgalo aquí: Version 3

Andy M.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas