Combinar varios Checkbox para realizar criterio de búsqueda con una macro

[Tenveo]

Hola a todos y gracias por vuestra ayuda de antemano.

Me he encontrado con un problema que no sé muy bien como resolver,

espero que alguien me pueda hechar una mano,

porque ya le he dado mil vueltas y estoy atascado, la verdad.

Gracias.

 

 

Sub buscar()

'Caso 1, compara fila por fila en el rango C1:C100
'Si en una fila encuentra el valor 1 y además el CheckBox1 está marcado escribe ok en F1
'Pero esta condición solo se ejecuta si el CheckBox1 está activado
'Si quiero recorrer todo el rango y escribir ok en cada acierto:
'Worksheets("Hoja1").Range("f" & i).Value = "ok"
Dim i As Integer

For i = 1 To 100
If Worksheets("Hoja1").Range("c" & i).Value = 1 _
And Worksheets("Hoja1").CheckBox1.Value = True Then
Worksheets("Hoja1").Range("f1").Value = "ok"
End If
Next i


End Sub


Sub buscar2()
'Caso 2, compara todos los Checkbox con en el rango C1:C100
'Ejemplo caso 1: si Ai = 1 y CheckBoxi = True entonces se escribe ok en Fi
'Ejemplo caso 2: si A1 y A3 = 1 y CheckBox1 y CheckBox3 = True entonces se escribe ok en G14

'El problema en el caso 1 es que no puedo asignarle i al nombre del CheckBox
'Y en el caso 2 tampoco sé como crear las distintas combinaciones entre cada una de las filas
'comprendidas en el rango C1:C100 con sus respectivos CheckBox
'sin escribir un millón de if


'Problema 1 con el caso 1
Dim i As Integer

For i = 1 To 100
If Worksheets("Hoja1").Range("c" & i).Value = 1 _
And Worksheets("Hoja1").CheckBox(i).Value = True Then
Worksheets("Hoja1").Range("f" & i).Value = "ok"
End If
Next i




'Problema 2 con el caso 2
If Worksheets("Hoja1").Range("c1").Value = 1 _
And Worksheets("Hoja1").CheckBox1.Value = True _
And Worksheets("Hoja1").Range("c2").Value = 1 _
And Worksheets("Hoja1").CheckBox2.Value = True Then
Worksheets("Hoja1").Range("G14").Value = "ok"
End If

If Worksheets("Hoja1").Range("c1").Value = 1 _
And Worksheets("Hoja1").CheckBox1.Value = True _
And Worksheets("Hoja1").Range("c3").Value = 1 _
And Worksheets("Hoja1").CheckBox3.Value = True Then
Worksheets("Hoja1").Range("G14").Value = "ok"
End If

'CheckBox1 + CheckBox50, CheckBox14 + CheckBox25, CheckBox1 + CheckBox1 + CheckBox2 + CheckBox3 + CheckBox15 + CheckBox50 ....etc
End Sub

 

demo.xlsm

[Antoni]

He eliminado todos los checkbox, para lo que quieres es mejor utilizar una fuente con caracteres especiales (Webdings).

En esta fuente, la a minúscula simula visualmente un checkbox, con lo cual es mucho más sencillo lo que pretendes.

Selecciona cualquier celda de la columna D y alternativamente se irá visualizando/eliminando el "checkbox".

Para ello he añadido esta macro en la hoja Hoja1.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Exit Sub 'Activar esta insrucción para manipular la columna D
If Target.Column = 4 Then
   If Target(1, 1) = "" Then
      Target(1, 1) = "a"
   Else
      Target(1, 1) = ""
   End If
   Target(1, 1).Offset(0, -1).Select
End If
End Sub

He adaptado la macro buscar al nuevo escenario. El resto inténtalo tú.

 

demo.xlsm

[Tenveo]

Hola Antoni,

muchísimas gracias por tu tiempo y por ayudarme con este tema.

 

Me encanta lo de los "nuevos CheckBox", sin duda es más elegante y productivo.

Además con la base de datos que trabaja se refresca mejor toda la pantalla.

 

El archivo que he subido obviamente solo es un pequeño ejemplo, pero en el real hay 700 CheckBox (una locura con la cual es muy fácil meter la pata)

Así que si consigo que todo me funcione bien los cambiaré por tu propuesta, pues me parece fantástica, de verdad.

 

El problema es que aun no consigo que funcione, intentaré explicarme mejor.

Tu solución me permite verificar si en el rango de las casillas marcadas, se da una concordancia y eso es genial.

Pero la cuestión es que, para que el sistema lo de por correcto, todas las casillas marcadas deben de dar una concordancia, si una de ellas falla, entonces no puede dar "ok"

Seguro que es "fácil" de arreglar, pero mis conocimientos son limitados.

¿Me hechas un último cable?

Gracias.

[Antoni]

O sea, ¿Todos los marcados en la columna D han de tener un 1 en la columna C?

[Tenveo]

Exacto Antoni

[Antoni]

Sub Buscar()
Dim i As Long
Application.ScreenUpdating = False
With Worksheets("Hoja1")
   .Range("f1") = ""
   For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
      If .Range("c" & i) = 1 And _
         .Range("d" & i) = "a" Then
         .Range("f1") = "ok"
      End If
      If .Range("c" & i) = 1 And _
         Not .Range("d" & i) = "a" Then
         .Range("f1") = ""
         Exit Sub
      End If
   Next i
End With
End Sub

 

[Tenveo]

¡Eres un crack, Antoni!

Muchas gracias

No te he podido responder antes porque llevo horas intentando integrarlo en el sistema.

Al final lo he conseguido ahora mismo, pero he sudado la gota gorda ?

Tu propuesta funcionaba, pero me daba error al usarla con otros subprocesos automatizados y tuve que ajustarlo todo.

Ya solo me queda una cosa, ¿cómo defines el alto del rango de los CheckBox?

Es decir, supongamos que tengo una tabla de datos hasta la fila 100, con tu código no puedo utilizar las filas siguientes para otras tareas (al menos la que se refiere al CheckBox, pues lo cambia todo por una "a")

Supongo que el tick de la cuestión está aquí

Cita

Target.Column = 4

Pues le estamos diciendo que el rango es toda la columna ¿cierto?

¿Cómo se ajusta a un rango determinado para que no haga eso?

He probado varias cosas pero no me han funcionado.

Un saludo y gracias de nuevo por tu colaboración y tiempo.

Quitado ese pequeño detalle ha quedado genial y es súper productivo.

Ahorra mucho tiempo y lo mejor, es eficaz, que a fin de cuentas es lo más importante.

Seguro que este código que has creado ayuda a muchas personas.

Fantástico, un 10.

[Antoni]

El check es una a minúscula, solo que la fuente Webdings la interpreta como un símbolo gráfico, por lo puedes cambiar el tamaño/negrita/color/...... del texto a voluntad, en definitiva, es una celda como cualquier otra.

Para poder modificarlo has de activar una línea de código y desactivarla una vez completados los cambios.

En cuanto al tema de acotar el rango, dime que rango es, por ejemplo D2 hasta el final o D4:D50,....

 

[Tenveo]

Hola Antoni,

feliz día.

 

Adjunto demo2 con el código ya modificado y un pequeño ejemplo del funcionamiento.

Así tu trabajo le servirá a más personas que lo necesiten.

A mí me ha ayudado mucho, así que en lo que a mí respecta, muchas gracias.

 

En cuanto al rango es indiferente, pues puede variar de un libro a otro, lo importante es saber lo que tengo que modificar, porque este código me sirve para otros proyectos similares que tengo.

Por ejemplo podría ser AF5:AF104

Como puedes ver en el demo2, la fuente después de los CheckBox es Calibri y sin embargo, al pinchar sobre cualquier celda de esa columna, escribe una "a"

He probado copiando el formato de otras celdas, pero parece no funcionar.

A ver que opinas de este ejemplo que he subido y encuentras dónde está el fallo.

Saludos

Demo 2.xlsm

[Antoni]

Para el archivo que has subido, rango D1:D10, quedaría así:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Exit Sub 'Activar esta insrucción para manipular la columna D

If Not Intersect(Target, Range("D1:D10")) Is Nothing Then '<----------------------
   If Target(1, 1) = "" Then
      Target(1, 1) = "a"
   Else
      Target(1, 1) = ""
   End If
   Target(1, 1).Offset(0, -1).Select
End If

End Sub

 

[Tenveo]

¡Genial Antoni!

Lo dicho, ¡eres un crack!

Muchas gracias.

 

Por mí el tema puede darse por cerrado y solucionado.

Creo que esto lo hacen los moderadores, porque no veo una opción por aquí para hacerlo.