Optimizar código y no tener un Case por cada registro
De nuevo necesito tu ayuda. El userform ("frmIngresoEquipos") para alimentar la base de datos ( hoja de calculo) con etiqueta ("RecopilaEquipo"), el cual uso la función CASE para registrar EQUIPO y nomina de jugadores de cada equipo con sus respectivo numero de Uniforme. El registro de cada equipo en la hoja es de la siguiente forma:
Registro Equipo 1
Nombre de Equipo, va en la celda "A3"
Nomina de Jugadores, va en el rango (B3:B22)
Numero de camiseta, va en el rango (C3:C22)
Registro Equipo 2
Nombre de Equipo, va en la celda "A4"
Nomina de Jugadores va en el rango (D3:D22)
Numero de camiseta, va en el rango (E3:E22
Registro Equipo 3
Nombre de Equipo, va en la celda "A5"
Nomina de Jugadores va en el rango (F3:F22)
Numero de camiseta, va en el rango (G3:G22
Así sucesivamente en ese orden, con lo demás equipos a registrar.
Resulta que para registrar cada equipo necesito un Case por registro y cada Case tiene Instrucciones a ejecutar de 40 lineas. Podrá imaginar lo tedioso de rutinas en caso de que fuesen 20 equipos ya que necesitaria 20 case. En tal sentido necesito un código o función que me supla el Select Case que permita optimizar la parte lógica.
Anexo información de vizualizacion para soportar la ayuda.
Case para registrar el equipo 1
1 respuesta
Te anexo el código para agregar los equipos, ya no es necesaria la función:
Private Sub cmdGuardar_Click()
'Act.Por.Dante Amor
Dim confirmacionRegistro As String
'
If optInsertar = False Then
MsgBox "Por favor seleccione opción Insertar", vbExclamation, "Informacion Importante"
Exit Sub
End If
If txtEquipo.Value = "" Then
MsgBox "Por favor ingresar el nombre de equipo", vbExclamation, "Informacion Importante"
Exit Sub
End If
'
Set h = Sheets("RecopilaEquipo")
Set b = h.Columns("A").Find(txtEquipo.Value, lookat:=xlWhole)
If Not b Is Nothing Then
MsgBox "EL EQUIPO YA EXISTE EN LA BASE DE DATOS. VERIFICA....", vbExclamation, "INFORMACION IMPORTANTE"
Exit Sub
End If
'
fila = h.Range("A" & Rows.Count).End(xlUp).Row + 1
col = 2
Do While h.Cells(2, col).Value <> ""
col = col + 2
Loop
'
h.Cells(2, col) = txtEquipo.Value
h.Cells(fila, "A") = txtEquipo.Value
nombre_eq = Replace(txtEquipo.Value, " ", "_")
ActiveWorkbook.Names.Add Name:=nombre_eq, RefersToR1C1:="=" & h.Name & "!R3C" & col & ":R22C" & col
'
For i = 1 To 20
h.Cells(i + 2, col).Value = Me.Controls("txtJugador" & i).Value
h.Cells(i + 2, col + 1).Value = Val(Me.Controls("txtCta" & i).Value)
Me.Controls("txtJugador" & i).Value = ""
Me.Controls("txtCta" & i).Value = ""
Next
txtEquipo.Value = ""
MsgBox "Equipo Guardado", vbInformation
End SubPrivate Sub cmdGuardar_Click()
'Act.Por.Dante Amor
Dim confirmacionRegistro As String
'
If optInsertar = False Then
MsgBox "Por favor seleccione opción Insertar", vbExclamation, "Informacion Importante"
Exit Sub
End If
If txtEquipo.Value = "" Then
MsgBox "Por favor ingresar el nombre de equipo", vbExclamation, "Informacion Importante"
Exit Sub
End If
'
Set h = Sheets("RecopilaEquipo")
Set b = h.Columns("A").Find(txtEquipo.Value, lookat:=xlWhole)
If Not b Is Nothing Then
MsgBox "EL EQUIPO YA EXISTE EN LA BASE DE DATOS. VERIFICA....", vbExclamation, "INFORMACION IMPORTANTE"
Exit Sub
End If
'
fila = h.Range("A" & Rows.Count).End(xlUp).Row + 1
col = 2
Do While h.Cells(2, col).Value <> ""
col = col + 2
Loop
'
h.Cells(2, col) = txtEquipo.Value
h.Cells(fila, "A") = txtEquipo.Value
nombre_eq = Replace(txtEquipo.Value, " ", "_")
ActiveWorkbook.Names.Add Name:=nombre_eq, RefersToR1C1:="=" & h.Name & "!R3C" & col & ":R22C" & col
'
For i = 1 To 20
h.Cells(i + 2, col).Value = Me.Controls("txtJugador" & i).Value
h.Cells(i + 2, col + 1).Value = Val(Me.Controls("txtCta" & i).Value)
Me.Controls("txtJugador" & i).Value = ""
Me.Controls("txtCta" & i).Value = ""
Next
txtEquipo.Value = ""
MsgBox "Equipo Guardado", vbInformation
End Sub
¡Gracias! , Muy agradecido por la ayuda
Hola Dante, Todo bien la Macro para sustituir la función Case, con la excepción que permite guardar registro con solo tener solamente el nombre del equipo. La idea es, Si los textBox correspondiente a jugadores y numero de uniforme no existe (En blanco) no permita guardar el registro
Saludos
Las validaciones las puedes poner después de estas líneas:
If txtEquipo.Value = "" Then MsgBox "Por favor ingresar el nombre de equipo", vbExclamation, "Informacion Importante" Exit Sub End If
Puedes poner algo como esto
For i = 1 To 20
if Me.Controls("txtJugador" & i).Value = "" or Me.Controls("txtCta" & i).Value = "" then
msgbox "Faltan datos"
exit sub
end if
Nextsal u dos
