Vuelta con Lista desplegable con dos valores

[JuanP]

Hola de nuevo, estoy siguiendo los pasos que me comentáis en el otro post para mostrar uno de los dos valores que aparecen en la lista desplegable.

He actualizado el archivo que puso Gerson para adaptarlo al contenido que intento poner, y lo extraño es que creando una celda con el mismo contenido que puso Gerson no sé por qué no funciona.

La Celda E2 es la que creo Gerson y funciona.
La Celda E4 es una copia de la anterior y no funciona.

Lo que intento hacer es aplicar en la celda H7 el método que está en la celda E2, pero como puedo aplicarlo en esta lista desplegable dependiente ?

 

Un saludo.

 

Lista con dos columnas - PRUEBAS.xlsm

[Jose BN]

Juan P esto sucede porque el evento Worksheet_Change que ha utilizado Gerson están dirigido a los cambio que ocurran en la celda E2, si lo que deseas es aplicar en E4 solo debes cambiar la referencia.

 

Private Sub Worksheet_Change(ByVal Target As Range)

'************ by Gerson Pineda ************
'************ Feb/2020 ************

On Error Resume Next
Application.EnableEvents = False
With Target
    If .Address(0, 0) = "E4" Then .Value = _
    VBA.Left(.Value, VBA.InStr(1, .Value, " ", vbTextCompare) - 1)
End With
Application.EnableEvents = True
On Error GoTo 0

End Sub

 

[JuanP]

Vale vale, joer que fallo, los ejemplos que veía no mostraban ningún tipo de código,  y me tenia despistado la función =INDICE(Tabla1[Unido];) que no llegaba a entender como podía sacar ese resultado, y no me dio por mirar ese código, pero en este caso ya tendría que aplicarlo a todos los días de un mes.

Y un segundo paso seria, que no se si es posible o hay alguna alternativa para conseguir lo mismo, mostrar la lista desplegable para que se vea entera con un ancho mayor al que tienen las celdas del mes.

 

 

 

[Jose BN]

Abusando de esta recomendación de Héctor Miguel

 

asumiendo que te refieres a los desplegables en listas de reglas de validación (?), mira por aquí:
- Drop Down List Too Wide
- Make the Dropdown List Temporarily Wider
- Make the Dropdown List Appear Larger
- Data Validation Tips and Quirks

[JuanP]

Gracias Jose, solo quería responderte, hasta el fin de semana no voy a poder ver los enlaces, a ver que tal se comporta San Google con las traducciones. 

 

 

 

[JuanP]

La curiosidad y las ganas de poder hacerlo a podido mas, y no he podido esperar, jeje.

Aunque no he podido probarlo a fondo creo que el único que podía utilizar es este Make the Dropdown List Temporarily Wider para que cuando se pulse sobre una celda se agrande y luego vuelva a tener su tamaño ya que la celda solo tendrá unos 4 caracteres.

Pero no se muy bien si este código se puede utilizar If Target.Count > 1 Then Exit Sub porque no va puesto en una sola columna, si no en la columnas que muestro en el ejemplo

 

[Jose BN]

Juan P. no logré ver la imagen que mencionas, pero veamos:

para que cuando se pulse sobre una celda se agrande y luego vuelva a tener su tamaño ya que la celda solo tendrá unos 4 caracteres.

A ver si damos en el clavo a lo que he logrado comprender:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Cells.Count > 1 Then Exit Sub
  If Intersect(Target, Range("h7:al7,h8:AL8")) Is Nothing Then
    ActiveWindow.Zoom = 100
  Else
    ActiveWindow.Zoom = 120
  End If
End Sub

 

[JuanP]

Hola Jose BN, con el zoom no sale con el resultado esperado, creo que es mejor ampliar la columna, mira como he dejado el archivo de ejemplo.

Lo que pasa que es mucho el código que hay que poner, no se si alguien puede simplificar ese código, y eso que en el ejemplo solo hay puesto unas cuantas celdas.

 

No se si se puede limitar para que el lugar de que se tomen columnas se pueda hacer para que sea un rango de celdas desde la K7 a la AO24, y que solo se aplique cuando esta en ese rango de celdas, ya que si se pulsa en una celda que este fuera del gráfico también pasa por esa función, y el poner Application.Volatile False en Worksheet_SelectionChange no sirve porque sigue pasando por esta macro cada vez que se situé el cursor en una celda, no se como se podría evitar este comportamiento.

 

 

 

 

 

 

 

Lista con dos columnas - PRUEBAS 3.xlsm

[Jose BN]

Juan P

A ver si con esto me invitas a un café :

 

Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim anchoG As Single
Dim anchoP As Single

anchoG = 24
anchoP = 5.57
    Static Col As Long
    If Target.Count > 1 Then Exit Sub
    If Target.Column >= 11 And Target.Column <= 41 Then
        Target.Columns.ColumnWidth = anchoG
        Else
Target.Columns.ColumnWidth = anchoP
    End If
    If Col > 0 Then
        Columns(Col).ColumnWidth = 8
    End If
    Col = Target.Column
End Sub

Saludos

J

[JuanP]

Jose café y copa como mínimo.

Has llegado a probar este código en el archivo, te lo pregunto porque a mi no me esta funcionando bien, antes de pregunta como simplificar algo mas el código también probé con If Target.Column >= 11 And Target.Column <= 41 Then y me mostraba un error, así que pensé que no era el correcto, no se si el resultado es el mismo si se pone >= o => porque puede que ahí estuviese el error,  no lo se ahora mismo. 

El caso es que ahora el comportamiento que me esta dando al pulsar sobre las columnas desde la 11 a la 41 no es el esperado, las columnas se quedan con el anchoG (abiertas), y cuando pulsas fuera de ese rango no se cierra.

Por otro lado el resto de celdas tampoco tienen porque cambiar de tamaño, que es lo que esta haciendo, he desactivado este código:

'    If Col > 0 Then
'        Columns(Col).ColumnWidth = 8
'    End If
    
'    Col = Target.Column

 

Y al desactivarlo, lo que pasa es que el resto de columnas ahora se cambian con el ancho que esta en "anchoP"

 

Una pregunta, ¿en lugar de hacerlo por columnas, no se puede hacer por un rango de celdas ?

Lo pregunto porque encima de ese calendario tengo puesto otras celdas y textos, y no queda bien que al pulsar sobre esas columnas tambien se agranden. 

 

[JuanP]

Como ya no puedo editar el post anterior lo comento aquí.

He probado a que solo detecte la celta para agrandarla de esta forma:

 

If Target.Column = 11 And Target.Row = 7 Then
          Target.Columns.ColumnWidth = anchoG
      Else
          Columns(11).ColumnWidth = anchoP
End If

y solo se agranda esa columna cuando esta en es celda, pero pasa lo mismo, como simplificar tanto código porque tendría que poner 558 códigos, uno para cada celda.

Y lo mismo me pasa con el código que esta puesto en Worksheet_Change que no se como simplificarlo para no tener que poner tanto código.

 

Un saludo.

 

 

 

 

 

[JuanP]

Bueno esto es lo que mas he podido reducir el código, y lo he limitado al rango de celdas que están en el calendario, no se si hay alguna otra forma de reducir o simplificar mas el código,

 

Un saludo.

 

 

 

 

 

Lista con dos columnas - PRUEBAS 4.xlsm

[Jose BN]

Lista con dos columnas - PARA JUAN P.xlsm

[bigpetroman]

Saludos @JuanP con estas dos macros haces todo lo que quieres, suerte

 

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next
    Application.EnableEvents = False
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("K7:AO24")) Is Nothing Then
        With Target
            .Value = VBA.Left(.Value, VBA.InStr(1, .Value, " ", vbTextCompare) - 1)
        End With
    End If
    Application.EnableEvents = True
On Error GoTo 0

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim anchoG As Single
    Dim anchoP As Single
    
    
    anchoG = 24
    anchoP = 5.57
    
    If Target.Count > 1 Then Exit Sub
    
    If Not Intersect(Target, Range("K7:AO24")) Is Nothing Then
        Target.Columns.ColumnWidth = anchoG
    Else
        Range("K7:AO24").Columns.ColumnWidth = anchoP
    End If
    
    
End Sub

 

[JuanP]

Gracias a los dos,

bigpetroman el código Worksheet_SelectionChange lo he tenido que modificar un poco porque cuando pasas dentro del rango de una celda a otra el anchoP no se cambia, lo he dejado así para que esas celdas también vuelvan a su ancho normal cuando se pasa de una celda a otra, porque solo volvían al anchoP cuando se pulsaba en una celda fuera de ese rango.

Este es el que me esta funcionado, no se si es el código mas correcto:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim anchoG As Single
Dim anchoP As Single
Dim numeroColumna As Long

anchoG = 24
anchoP = 5.57

If Not Intersect(Target, Range("$K7:$AO24")) Is Nothing Then

    If Target.Count > 1 Then Exit Sub
    
    numeroColumna = Target.Column
    
    If Target.Column >= 11 And Target.Column <= 41 Then
        Columns.Range("$K7:$AO24").ColumnWidth = anchoP
    End If
    
    If Target.Column = numeroColumna Then
            Target.Columns.ColumnWidth = anchoG
        Else
            Columns(numeroColumna).ColumnWidth = anchoP
    End If

End If
  
    If Intersect(Target, Range("$K7:$AO24")) Is Nothing Then Columns.Range("$K7:$AO24").ColumnWidth = anchoP

End Sub

 

Lo que no me esperaba es el comportamiento del código Worksheet_SelectionChange porque parece que lo primero que hace es poner el texto completo "1 - Mañana" por un momento, que no se aprecia, y luego deja el primer valor "1",  y tengo puesto un buscador que lo primero que hace es saltar un error de no encontrado porque busca el texto completo.

Pero esto ya lo preguntare en otro post a ver si se puede solucionar, porque si no, no podria utilizar nade de esto    ( ͡ಥ ͜ʖ ͡ಥ)

 

 

 

 

 

[Jose BN]

La conclusión ha llegado para ti o continua otra ronda para el vino?

[JuanP]

Si Jose BN al estar uno cerca del otro confundi el boton, el codigo lo modifique como te dije en el archivo que te pase, pero creo que respondiste aqui antes, y no como te dije me llego notificación de esto, ese codigo que he puesto es el que te pase porque no terminaba de cerrar las columnas.

 

 

 

 

 

[bigpetroman]

Saludos @JuanP te dejo la macro con el cambio para que cuando pases de una columna a otra se ajusten todas primero al tamaño original

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim anchoG As Single
    Dim anchoP As Single
    
    
    anchoG = 24
    anchoP = 5.57
    
    If Target.Count > 1 Then Exit Sub
    
    If Not Intersect(Target, Range("K7:AO24")) Is Nothing Then
        Range("K7:AO24").Columns.ColumnWidth = anchoP 'ESTA ES LA FILA NUEVA
        Target.Columns.ColumnWidth = anchoG
    Else
        Range("K7:AO24").Columns.ColumnWidth = anchoP
    End If
    
End Sub

Lo otro que dices, pues no lo entiendo, según lo que yo vi en tu macro original, eso es lo que hace, simplemente seleccionas lo que quieres y dejas el texto que está justo antes del primer espacio, no es eso, o que falta?