Agregar otra condición más a cualquier de esta dos fórmulas
De nuevo por aquí expertos,
Tengo un libro de excel sobre un concurso que me ayudo con el modulo el experto JAMES BOND y ANDY MACHIN, que consta de 2 hojas la primera se llama Alumnos y la otra configuración, lo que deseo es que en la hoja alumno al momento de darle click al botón calcular en la hoja Alumno me arroje si es APROBADO Y DESAPROBADO, las 2 macros que voy adjuntar funcionan perfectamente la primera condición evalúa la hoja Alumnos con sus columna Nota Final y la compara con la hoja Configuración si cumple con dicha nota mínima aprobatoria y su cuadro de cursos la cual funciona excelente las macros
Ahora lo que deseo es como se puede agregar a esos mismos códigos otra condición más para que me evalué en la Hoja Alumnos la columna Merito y la hoja configuración la columna Cant. Ejemplo que si tengo en la hoja configuración tengo para LENGUAJE que solo van a ingresar solo 2 cupos al momento de compararse con la hoja Alumno de la columna merito solo acepte hasta 2 como Aprobado así tenga nota aprobatoria por que todos no pueden entrar para ese concurso, ya que los orden de méritos por cada curso están por separados la cual los he sombreado de diferentes colores.
Intente haciendo este código para agregar a su código pero no me salio.
For T = 3 To uf1
If Sheets("Alumnos").Cells(i + 1, 3) = Sheets("Configuracion").Cells(T, 2) Then
aprobado = Sheets("Configuracion").Cells(T, 3)
End If
Next TAsí debería quedar el resultado de la hoja Alumnos cuando calcule APROBADO Y DESAPROBADO
Y esta es la hoja configuración donde controlo la nota mínima aprobatoria y la cantidad de cupos que se requiera para dichos cursos.
Este es el código que me ayudo el experto JAMES BOND la cual le quiero agregar la otra condición más para que me evalué dos criterios diferentes.
Sub PONER_ESTADO()
Set HA = Worksheets("ALUMNO")
Set HC = Worksheets("CONFIGURACION")
Set ALUMNOS = HA.Range("A2").CurrentRegion
NOTA_APROB = HC.Range("G3")
With ALUMNOS
FILAS = .Rows.Count
For I = 2 To FILAS
CALIFICACION = .Cells(I, 4) < NOTA_APROB
If CALIFICACION Then
.Cells(I, 6) = "DESAPROBADO"
Else
.Cells(I, 6) = "APROBADO"
End If
Next I
End With
Set ALUMNOS = Nothing: Set HA = Nothing: Set HC = Nothing
End SubEste es el código que me ayudo el experto ANDY MACHIN, la cual le quiero agregar la otra condición mas para que me evalué dos criterios diferentes.
Sub CristianRosales()
Dim Alumnos As Worksheet: Set Alumnos = Sheets("Alumnos")
Dim Config As Worksheet: Set Config = Sheets("Configuracion")
Dim uF As Long
Dim minAprobado As Byte
Dim rCell As Range, rRng As Range
uF = Alumnos.Range("A" & Rows.Count).End(xlUp).Row
minAprobado = Config.Range("G3").Value
Set rRng = Alumnos.Range("D3:D" & uF)
For Each rCell In rRng.Cells
Select Case rCell.Value
Case Is >= minAprobado
rCell.Offset(0, 2).Value = "APROBADO"
Case Else
rCell.Offset(0, 2).Value = "DESAPROBADO"
End Select
Next rCell
End Sub
Este es el resultado de la macro te deja al fina los resultados ordenados por cada curso de la calificación mayor a la menor, asignado el numero 1 a la calificación más alta, el numero 2 a la 2a calificación, as alta y así sucesivamente, si quieres que la tabla quede ordenada por items entonces solo activa las líneas del código que están en verde
y esta es la macro
Sub evalua_alumnos()
Set HA = Worksheets("alumno")
Set HC = Worksheets("configuracion")
Set ALUMNOS = HA.Range("a2").CurrentRegion
Set CURSOS = HC.Range("a2").CurrentRegion.Columns(2)
nota_aprobatoria = HC.Range("g3")
With ALUMNOS
FILAS = .Rows.Count
For I = 2 To FILAS
nota = .Cells(I, 4) >= nota_aprobatoria
If nota Then .Cells(I, 6) = "APROBADO" Else: .Cells(I, 6) = "DESAPROBADO"
Next I
End With
With CURSOS
FILAS = .Rows.Count
For I = 2 To FILAS
CURSO = .Cells(I)
CUENTA = WorksheetFunction.CountIf(ALUMNOS.Columns(3), CURSO)
INDICE = WorksheetFunction.Match(CURSO, ALUMNOS.Columns(3), 0)
Set MERITOS = ALUMNOS.Rows(INDICE).Resize(CUENTA)
With MERITOS
.Interior.ColorIndex = I + 2
.Sort KEY1:=HA.Range(.Columns(4).Address), ORDER1:=xlDescending
.Cells(1, 5) = 1
If CUENTA > 1 Then
.Cells(1, 5).AutoFill Destination:=Range(.Columns(5).Address), Type:=xlFillSeries
End If
End With
Next I
End With
'With ALUMNOS
' .Sort KEY1:=HA.Range(.Columns(1).Address), ORDER1:=xlAscending, Header:=True
'End With
Set ALUMNOS = Nothing: Set CURSOS = Nothing
Set HA = Nothing: Set HC = Nothing
End Sub
1 respuesta más de otro experto
No entiendo el concepto de Merito. ¿Cómo sé cuales entran en el curso? Mirando la imagen, interpreto que entran los dos que tienen un merito más bajo. ¿Es así?
Gracias por responder experto Andy Machin, el orden de mérito que está en la hoja alumno viene hacer el puesto que le correspondería a cada nota el que tiene la más alta se le asigna 1 ya es el primer puesto y así sucesivamente y si yo sé que en mi hoja configuración tengo para el curso de Lenguaje que solo van ingresar 2 personas, entonces en mi hoja alumna me debe arrojar 2 aprobados para el curso de lenguaje ya que de los 4 registros que tengo para el curso de lenguaje según el orden de mérito solo 2 pueden ingresar
Ya entiendo, dame unos minutos para diseñar el procedimiento.. parece un poco complejo, a ver que se me ocurre.
Ya con esta condición agregada al código ya podría controlar totalmente los ingresos a dichos cursos tanto con la nota mínima aprobatoria y el orden de mérito
Mientras voy pensando, ¿me puedes compartir el libro? Súbelo a algún drive, para ir haciendo pruebas en el.
Ya se me ocurrió como hacerlo, es sencillo en realidad ja ja esperame unos minutos y te mando el código
Allí esta el enlace experto Andy Machin,
https://drive.google.com/file/d/1xE9pgWxYPPXf3wUnGnPIcXLCvliLs7z7/view?usp=sharing
Ya lo tengo, pero me he encontrado un problema. Supongo que es error tuyo. En el curso MATEMÁTICA, hay dos con merito 3. Supongo que te has equivocado y YENSON debería tener merito 2.
Aquí esta el código:
Sub CristianRosales()
Dim Alumnos As Worksheet: Set Alumnos = Sheets("Alumnos")
Dim Config As Worksheet: Set Config = Sheets("Configuracion")
Dim uF As Long
Dim minAprobado As Byte
Dim rCell As Range, rRng As Range
Dim cArr As Variant, i As Integer
uF = Config.Range("A" & Rows.Count).End(xlUp).Row
cArr = Config.Range("B3:C" & uF)
uF = Alumnos.Range("A" & Rows.Count).End(xlUp).Row
minAprobado = Config.Range("G3").Value
Set rRng = Alumnos.Range("D3:D" & uF)
For Each rCell In rRng.Cells
For i = LBound(cArr) To UBound(cArr)
If cArr(i, 1) = rCell.Offset(0, -1).Value Then
If rCell.Value >= minAprobado And rCell.Offset(0, 1).Value <= cArr(i, 2) Then
rCell.Offset(0, 2).Value = "APROBADO"
Else
rCell.Offset(0, 2).Value = "DESAPROBADO"
End If
End If
Next i
Next rCell
End SubMe funciona bien a mi
¡Gracias!
Quedo excelente experto Andy Machin, ahora si me va controlar el 100% de los ingresos, y con el tema de matemática si tiene razón fue error mio en vez 3 fue 2, para que quede 2,1,3 en matemática.
Saludos
Vale, para que funcione siempre, debes asegurarte que, al introducir cursos nuevos o alumnos nuevos, el nombre del curso debe coincidir exactamente en ambas tablas. Si un curso se llama FISICA y en un alumno le ponen FICICA ya se genera un problema, no dará error, pero no funcionará como esperas.
Si necesitas una explicación de como funciona el código me avisas.