Ayuda macro para definir camino

[Andres_tg]

Hola a todos, muchas gracias a todos por la ayuda soy nuevo en esto .

Os comento lo que quiero que haga la macro, si es posible, tengo que hacer un camino desde un punto "A" hasta un punto "B". Adjunto plano.

En la columna "Inicio" coloco el punto de inicio, en este ejemplo tengo dos "A y D" y tengo dos puntos de finalización "B y C" no hay columna para definirlos.

Por ejemplo quiero ir de "A" a "B" entonces el camino sería US1, US2,US3, US4, US5.  Al colocar en la columna "Inicio" "A" en la siguiente columna "Canalizacion1" me aparece una lista desplegable con "US1" que escojo manualmente, la siguiente columna "Canalización 2  me aparece una lista desplegable con "US2" que escojo manualmente, la siguiente columna "Canalización3 me aparece una lista desplegable con "US3, US6 y US9" y  escojo manualmente "US3" que es por donde tengo que ir, la siguiente columna seria "US4" y la ultima columna sería "US5".

Por si no ha quedado claro la ruta la escojo manualmente pero las opciones de la ruta se hacen automáticamente. No se si me he expresado bien y se puede entender, si tenéis alguna duda me preguntáis.

Muchas gracias por vuestra ayuda.

Ruta.xlsx

[Israel Cassales]

Hola.

Intento participar en esta consulta porque mi fuerte no es el VBA, con la sentencia siguiente.

El primer reto que vi es que es una imagen, entonces el camino a seguir no está dentro de la hoja. Como no supe convertir la imagen en unos rangos que pueda usar, digamos que lo marque en un rango de celdas.

En la sentencia para definir el origen doy clic en A o en D, después voy indicando el camino en base a selecciones con el cursor hasta que le doy en una celda que llame FIN.

Para que tome el dato hacia una lista despegable, las celdas que fui seleccionando las fui copiando en un rango subsecuente a donde van los datos y así se puedan usar. Aunque ya haciéndolo, en mi opinión tal vez ya no sean necesarios porque podrían copiarse (aparecer) dentro de la tabla que se requiere.

Sé que no cumple cabalmente con lo que requiere el consultante pero ojalá ayude en algo.

Saludines.

 

 

[Israel Cassales]

La sentencia, ésta se debe pegar en la hoja donde estarían las coordenadas.

Option Explicit

Dim RangoCoord As Range
Dim Origen As String
Dim colActual As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("D15:D21")) Is Nothing Then
        Origen = Target.Value
        colActual = 0
    ElseIf Not Intersect(Target, Range("E15:H21")) Is Nothing Then
        Set RangoCoord = Intersect(Target, Range("E15:H21"))
    ElseIf Target.Address = "$I$22" Then
        Set RangoCoord = Nothing
    End If
    
    If Not RangoCoord Is Nothing Then
        If Not Intersect(Target, RangoCoord) Is Nothing Then
            Target.Interior.Color = vbGreen
            Select Case Origen
                Case "A"
                    Range("L2").Offset(0, colActual).Value = Target.Value
                Case "D"
                    Range("L3").Offset(0, colActual).Value = Target.Value
            End Select
            colActual = colActual + 1
        End If
    End If
End Sub

 

[Andres_tg]

Hola, muchas gracias Israel por tu aportación me parece interesante la propuesta que has hecho no lo había pensado de esta manera,  se podría hacer unos cambios para que funcione como espero:

Cuando se termine de hacer un camino que las celdas verdes vuelvan a ser de color blanco. 

Que se añadan más filas, porque es la ruta que tienen que seguir unos cables eléctricos y no se si serán 5, 8, 10, o 20 cables.

Desde ya muchas gracias por la ayuda.

[Andres_tg]

Hola a todos, he conseguido resolver este problema sin tener que usar macros, solo he tenido que usar tablas, validación de datos y la función indirecto.

Muchas gracias por vuestra ayuda.

Doy por cerrado el tema.

Si alguien quiere que le explique como lo he hecho, no dude en preguntarlo.

[Israel Cassales]

Hola @Andres_tg

Un gusto saber que lo hayas logrado, sin macros me parece que les diste nombre a las tablas donde registraste las coordenadas para que en la validación de datos al incluir en "lista" la función INDIRECTO() vaya cambiando de acuerdo a la selección anterior. Aunque me pareció divertido intentarlo con una sentencia VBA como solicitabas inicialmente ?

Si tuvieras el ejemplo para compartir con los demás se agradecería, considero que siempre es buena idea el dejar cómo se ha solucionado, enriquece al foro y ayuda a los posibles lectores futuro.

¡Hasta la próxima!

[Andres_tg]

Hola a todos, efectivamente lo he hecho como has comentado @Israel Cassales.  Ahora que he resuelto esta parte se me ha ocurrido añadir algo más,  supongamos que tienes hecho un camino pero te das cuenta que te has equivocado en alguna parte del camino y tienes que cambiar, la idea es que a partir de la columna que haces el cambio las columnas de la derecha se borran para que vuelvas a introducir el nuevo camino. Esto lo he hecho con una macro para la primera fila, pero me gastaría que se hiciera de forma automática para el resto de filas (el numero de filas puede variar).

Si me podéis ayudar con esta parte estaría muy agradecido.

El archivo adjunto tiene la parte resuelta de como hacer el camino y la de borrar las columnas si se hace un cambio en la primera fila.

 

Rutado CablesTABLA.xlsm

[Israel Cassales]

[Israel Cassales]

Se supone que el tema está solucionado, no sé si se deban continuar.

Me tome la libertad de modificar tu sentencia, pega en la misma hoja donde tenías la tuya.

Private Sub Worksheet_Change(ByVal Target As Range)
       If Not Intersect(Target, Range("E2:N1000")) Is Nothing Then
           Application.EnableEvents = False
           If Target.Count > 1 Then
               Dim cell As Range
            For Each cell In Target
                   If cell.Value = "" Then
                       Range(cell.Offset(0, 1), Cells(cell.Row, "N")).ClearContents
                End If
            Next cell
        Else
               If Target.Value = "" Then
                   Range(Target.Offset(0, 1), Cells(Target.Row, "N")).ClearContents
            End If
        End If
           Application.EnableEvents = True
    End If
End Sub

 

[Israel Cassales]

Bueno, mejor te dejo el libro donde hice las pruebas.

Saludines

Rutado CablesTABLA.xlsm

[Andres_tg]

En 28/4/2023 at 21:30 , Israel Cassales dijo:

Bueno, mejor te dejo el libro donde hice las pruebas.

Saludines

Rutado CablesTABLA.xlsm 25.62 kB · 0 descargas

Muchas gracias por la ayuda me ha servido.