Error: Procedimiento demasiado largo Excel

Realice el siguiente código en excel 

Sub Bisel_BotonHecho()
' FUTBOL
If ActiveSheet.Cells(8, 1).Value = "Futbol" Then
Sheets("Futbol").Range("D4").Value = Sheets("Futbol").Range("D4").Value + 1 ' Contador General Futbol
' Evaluación del Curso (Excelente, Bueno, Regular, Malo)
If ActiveSheet.Cells(3, 14).Value = "1" Then
Sheets("Futbol").Range("D7").Value = Sheets("Futbol").Range("D7").Value + 1
End If
If ActiveSheet.Cells(3, 14).Value = "2" Then
Sheets("Futbol").Range("D8").Value = Sheets("Futbol").Range("D8").Value + 1
End If
If ActiveSheet.Cells(3, 14).Value = "3" Then
Sheets("Futbol").Range("D9").Value = Sheets("Futbol").Range("D9").Value + 1
End If
If ActiveSheet.Cells(3, 14).Value = "4" Then
Sheets("Futbol").Range("D10").Value = Sheets("Futbol").Range("D10").Value + 1
End If
'Trato (Excelente, Bueno, Regular, Malo)
If ActiveSheet.Cells(4, 14).Value = "1" Then
Sheets("Futbol").Range("C16").Value = Sheets("Futbol").Range("C16").Value + 1
End If
If ActiveSheet.Cells(4, 14).Value = "2" Then
Sheets("Futbol").Range("C17").Value = Sheets("Futbol").Range("C17").Value + 1
End If
If ActiveSheet.Cells(4, 14).Value = "3" Then
Sheets("Futbol").Range("C18").Value = Sheets("Futbol").Range("C18").Value + 1
End If
If ActiveSheet.Cells(4, 14).Value = "4" Then
Sheets("Futbol").Range("C19").Value = Sheets("Futbol").Range("C19").Value + 1
End If
'Conocimiento (Excelente, Bueno, Regular, Malo)
If ActiveSheet.Cells(5, 14).Value = "1" Then
Sheets("Futbol").Range("D16").Value = Sheets("Futbol").Range("D16").Value + 1
End If
If ActiveSheet.Cells(5, 14).Value = "2" Then
Sheets("Futbol").Range("D17").Value = Sheets("Futbol").Range("D17").Value + 1
End If
If ActiveSheet.Cells(5, 14).Value = "3" Then
Sheets("Futbol").Range("D18").Value = Sheets("Futbol").Range("D18").Value + 1
End If
If ActiveSheet.Cells(5, 14).Value = "4" Then
Sheets("Futbol").Range("D19").Value = Sheets("Futbol").Range("D19").Value + 1
End If
'Experiencia (Excelente, Bueno, Regular, Malo)
If ActiveSheet.Cells(6, 14).Value = "1" Then
Sheets("Futbol").Range("E16").Value = Sheets("Futbol").Range("E16").Value + 1
End If
If ActiveSheet.Cells(6, 14).Value = "2" Then
Sheets("Futbol").Range("E17").Value = Sheets("Futbol").Range("E17").Value + 1
End If
If ActiveSheet.Cells(6, 14).Value = "3" Then
Sheets("Futbol").Range("E18").Value = Sheets("Futbol").Range("E18").Value + 1
End If
If ActiveSheet.Cells(6, 14).Value = "4" Then
Sheets("Futbol").Range("E19").Value = Sheets("Futbol").Range("E19").Value + 1
End If
'Inconveniente Si/No
If ActiveSheet.Cells(7, 14).Value = "1" Then
Sheets("Futbol").Range("C23").Value = Sheets("Futbol").Range("C23").Value + 1
End If
If ActiveSheet.Cells(7, 14).Value = "2" Then
Sheets("Futbol").Range("C24").Value = Sheets("Futbol").Range("C24").Value + 1
End If
'Resueltos Inconvenientes Si/No
If ActiveSheet.Cells(8, 14).Value = "1" Then
Sheets("Futbol").Range("E23").Value = Sheets("Futbol").Range("E23").Value + 1
End If
'Implementos (Excelente, Bueno, Regular, Malo)
If ActiveSheet.Cells(9, 14).Value = "1" Then
Sheets("Futbol").Range("C28").Value = Sheets("Futbol").Range("C28").Value + 1
End If
If ActiveSheet.Cells(9, 14).Value = "2" Then
Sheets("Futbol").Range("C29").Value = Sheets("Futbol").Range("C29").Value + 1
End If
If ActiveSheet.Cells(9, 14).Value = "3" Then
Sheets("Futbol").Range("C30").Value = Sheets("Futbol").Range("C30").Value + 1
End If
If ActiveSheet.Cells(9, 14).Value = "4" Then
Sheets("Futbol").Range("C31").Value = Sheets("Futbol").Range("C31").Value + 1
End If
'Escenarios (Excelente, Bueno, Regular, Malo)
If ActiveSheet.Cells(10, 14).Value = "1" Then
Sheets("Futbol").Range("D28").Value = Sheets("Futbol").Range("D28").Value + 1
End If
If ActiveSheet.Cells(10, 14).Value = "2" Then
Sheets("Futbol").Range("D29").Value = Sheets("Futbol").Range("D29").Value + 1
End If
If ActiveSheet.Cells(10, 14).Value = "3" Then
Sheets("Futbol").Range("D30").Value = Sheets("Futbol").Range("D30").Value + 1
End If
If ActiveSheet.Cells(10, 14).Value = "4" Then
Sheets("Futbol").Range("D31").Value = Sheets("Futbol").Range("D31").Value + 1
End If
'Convenios (Excelente, Bueno, Regular, Malo)
If ActiveSheet.Cells(11, 14).Value = "1" Then
Sheets("Futbol").Range("E28").Value = Sheets("Futbol").Range("E28").Value + 1
End If
If ActiveSheet.Cells(11, 14).Value = "2" Then
Sheets("Futbol").Range("E29").Value = Sheets("Futbol").Range("E29").Value + 1
End If
If ActiveSheet.Cells(11, 14).Value = "3" Then
Sheets("Futbol").Range("E30").Value = Sheets("Futbol").Range("E30").Value + 1
End If
If ActiveSheet.Cells(11, 14).Value = "4" Then
Sheets("Futbol").Range("E31").Value = Sheets("Futbol").Range("E31").Value + 1
End If
End If ' Fin If Futbol
'---------------------------------------------------------------------------------
' VOLEIBOL
If ActiveSheet.Cells(8, 1).Value = "Voleibol" Then
Sheets("Voleibol").Range("D4").Value = Sheets("Voleibol").Range("D4").Value + 1 ' Contador General Voleibol
' Evaluación del Curso (Excelente, Bueno, Regular, Malo)
If ActiveSheet.Cells(3, 14).Value = "1" Then
Sheets("Voleibol").Range("D7").Value = Sheets("Voleibol").Range("D7").Value + 1
End If
If ActiveSheet.Cells(3, 14).Value = "2" Then
Sheets("Voleibol").Range("D8").Value = Sheets("Voleibol").Range("D8").Value + 1
End If
If ActiveSheet.Cells(3, 14).Value = "3" Then
Sheets("Voleibol").Range("D9").Value = Sheets("Voleibol").Range("D9").Value + 1
End If
If ActiveSheet.Cells(3, 14).Value = "4"...

1 respuesta

Respuesta
1

Digamos que se nota..... ;)

Mira, te armé la idea y luego te programé solo para Voleibol para que tomes la idea y repitas en el resto de los deportes.

Todavía se puede reducir más pero mejor lo dejas separado x disciplina.

Tomá lápiz y papel y verificá las ref y los valores que toman las variables si te parece algo difícil de comprender.

Sub CONSULTA()
'x Elsamatilde
'según de qué hoja se trate se procede
Select Case ActiveSheet.Cells(8, 1).Value
Case Is = "FÚTBOL"
'líneas para Fútbol

Case Is = "VOLEIBOL"
Sheets("Voleibol").Range("D4").Value = Sheets("Voleibol").Range("D4").Value + 1 ' Contador General Voleibol
' Evaluación del Curso (Excelente, Bueno, Regular, Malo)
For i = 1 To 4
'la celda D depende del valor de i. Para D7 i=1, para D8 i=2 entonces es range("D6").Offset(0,i)
If ActiveSheet.Cells(3, 14).Value = i Then
Sheets("Voleibol").Range("D6").Offset(0, i).Value = Sheets("Voleibol").Range("D6").Offset(0, i).Value + 1
End If
Next i
'Trato (Excelente, Bueno, Regular, Malo)
'como aquí se repiten las opciones para filas 4,5 y 6, con celdas a partir de col C, D y E (o sea 3, 4 y 5) se hace otro bucle
col = 3
For x = 4 To 6
For i = 1 To 4
If ActiveSheet.Cells(x, 14).Value = i Then
Sheets("Voleibol").Cells(15, col).Offset(0, i).Value = Sheets("Voleibol").Cells(15, col).Offset(0, i).Value + 1
End If
Next i
'aumento en 1 la col porque ahora paso para col D, luego E
col = col + 1
Next x
'Inconveniente Si/No
If ActiveSheet.Cells(7, 14).Value = "1" Then
Sheets("Voleibol").Range("C23").Value = Sheets("Voleibol").Range("C23").Value + 1
ElseIf ActiveSheet.Cells(7, 14).Value = "2" Then
Sheets("Voleibol").Range("C24").Value = Sheets("Voleibol").Range("C24").Value + 1
End If
'Resueltos Inconvenientes Si/No
If ActiveSheet.Cells(8, 14).Value = "1" Then
Sheets("Voleibol").Range("E23").Value = Sheets("Voleibol").Range("E23").Value + 1
End If
'Implementos (Excelente, Bueno, Regular, Malo)
'como aquí se repiten las opciones para filas 9, 10 y 11, con celdas a partir de col C, D y E (o sea 3, 4 y 5) se hace otro bucle
col = 3
For x = 9 To 11
For i = 1 To 4
If ActiveSheet.Cells(x, 14).Value = i Then
Sheets("Voleibol").Cells(27, col).Offset(0, i).Value = Sheets("Voleibol").Cells(27, col).Offset(0, i).Value + 1
End If
Next i
'aumento en 1 la col porque ahora paso para col D, luego E
col = col + 1
Next x
' Fin If Voleibol

Case Is = "MICROFUTBOL"
'líneas para microfutbol

Case Is = "AJEDREZ"
'.....
End Select
End Sub

Preparalo y probalo, luego me comentas

PD) Todo los tipos de bucles en mis manuales de Macros ;)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Como incrustar imagen en celda Excel con datos de Access 2013

Quisiera saber si es posible exportar datos de Access a Excel e incrustar automáticamente la imagen a la que hace referencia una url dentro de la tabla de Access. Tengo una tabla que contiene la dirección de una imagen dentro de carpetas de mi pc, y...
2 respuestas

Hacer un ranking de un rango de números

Sobre un rango de celdas en las cuales solo hay números, necesito una función que de por resultado los 10 números más repetidos en dicho rango. Que numero esta en el primer puesto, que numero en el segundo puesto, etc hasta el puesto 10. El rango de...
1 respuesta

Numero con más repeticiones dentro de un rango

En la columna "Numero" tengo los números del 1 al 20 y en la columna "Repetido" tengo las veces que se repitió cada numero, Ejemplo el numero 10 se repitió 6 veces, el numero 11, se repitió 9 veces etc. Necesito una función que me de por resultado el...
1 respuesta

Buscar y copiar filas con una fecha determinada en una celda

Necesito saber como hacer la fórmula para que me localice la fecha que tengo en una determinada celda y no en este caso que así solo me busca la fecha del día de hoy 'Encontrar la última fila con datos en la hoja de origen lastRow =...
2 respuestas

Suma entre rango de fechas para un cliente

Nola, necesito hacer una suma entre un rango de fechas para un cliente definido. Elijo un rango de fechas y luego elijo un cliente de la celda de clientes y me da por resultado la suma de lo facturado de ese cliente dentro del rango de fechas...
3 respuestas

Necesito separar los dos nombres y los dos apellidos en una planilla excel

Tengo una planilla con tanto los nombres y apellido una solo a columna y necesito separar los dos nombres y los dos apellidos en columnas independiente
1 respuesta

Tengo una base de datos escrita en columnas

Necesito que quede escrita de la siguiente forma ¿Cómo lo puedo hacer?
3 respuestas

Macro para cortar un texto en 25 caracteres

Me ayudan a generar una macro que corte un texto que está en la celda A2 en 2 textos, el primer texto que lo ponga en la celda B2, no deberá cortar ninguna palabra deberá cortar el texto en máximo 25 caracteres y cortarlo en donde haya un blanco, el...
4 respuestas

Seleccionar datos mediante un Combobox en formulario

Tengo un listado de números en una columna y me gustaría seleccionar cada número mediante un Combobox de un formulario, su parte inicial sería la siguiente prívate sub combobox_change() Range (“ex”)
2 respuestas

Detectar si hay caracteres raros o acentos en texto excel

Tengo una base de datos que me da error cuando intento encontrar un texto en un campo, independientemente de si está acentuado o no y me da la sensación de que hay algún carácter raro en algún texto. ¿Hay alguna fórmula que me encuentre todos los...
2 respuestas