Carrera de Caballos: Uso del With y también el For, Do y el While Wend

La macro recrea una carrera de caballos, Cuando se da un clic a "Competidores al punto de partida" aparece un INPUTBOX que te pide la cantidad de caballos a concursar, ojo que tienes un máximo de 15 caballos y dicho número de concursantes aparece en el excel. Luego aparece el segundo INPUTBOX que te pide escoger la pista de carrera para lo cual te da a escoger entre pasto o lodo y una vez escogida la pista, el color de la pista cambiará a verde (pasto) o marrón (lodo) en el excel. La instrucción With se utilizó para crear la pista de carrera y se realizó a través de un grabador de macro, el cual agrupo el formato de cada pista de carrera a través de un With.

Finalmente podrás darle clic a "Iniciar la Carrera" y verás como los caballos se desplazarán de columna en columna en el excel y cuando lleguen a la meta aparecerá un MSGBOX "Ganó Caballo #".

A continuación el código:

Sub CARRERA()
Dim Final_De_Carrera As Boolean
Dim CompetidorEncontrado As Boolean
Dim caballo As Integer
Dim columna As Integer
Dim j As Long
' Creamos una variable LOGICA llamada FINAL_DE_CARRERA
Sheets("Hoja1").Select
Final_De_Carrera = False
While Final_De_Carrera = False
caballo = Int(Rnd() * Cells(1, 1).Value + 1)
CompetidorEncontrado = False
columna = 1
While CompetidorEncontrado = False
If Cells(3 + caballo, columna).Value = caballo Then
CompetidorEncontrado = True
Else
columna = columna + 1
End If
Wend
Cells(3 + caballo, columna + 1).Value = Cells(3 + caballo, columna).Value
Cells(3 + caballo, columna).ClearContents

If columna = 49 Then
Final_De_Carrera = True
End If
x = 0
If Range("B1") = "pasto" Then
For j = 1 To 10000
x = x + 1
Next j
End If
If Range("B1") = "lodo" Then
For j = 1 To 1000000
x = x + 1
Next j
End If

Wend
MsgBox "Ganó caballo: " & caballo

End Sub

 

Sub pasto()
'
' pasto Macro
'

'
Range("A4:AX18").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub lodo()
'
' lodo Macro
'

'
Range("A4:AX18").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.499984740745262
.PatternTintAndShade = 0
End With
End Sub
Sub COMPETIDORES_A_LA_PARTIDA()
On Error GoTo MisErrorcitos

Sheets("Hoja1").Select
Cells.ClearContents
Do
competidores = InputBox("Cantidad de competidores: " & Chr(13) & "máximo 15 competidores") * 1
Loop Until competidores >= 2 And competidores <= 15
Cells(1, 1).Value = competidores
For i = 1 To competidores
Cells(3 + i, 1).Value = i
Next i
Do
pistatipo = LCase(InputBox("Indicar tipo de pista" & Chr(13) & "tipo: pasto ó lodo"))
Loop Until pistatipo = "pasto" Or pistatipo = "lodo"
Range("B1") = pistatipo
If pistatipo = "pasto" Then
pasto
Else
lodo
End If
Range("A4").Select
Exit Sub
MisErrorcitos:
competidores = 10
Resume Next
End Sub

Apuesta y Juégalo!!!Carrera de Caballo.

Jorge Wankun