Recorrido Entrada Datos

[xavima]

Hola a Toda la Comunidad,

Nuevamente recurro a vosotros para solucionar una pequeñez para vosotros y una montaña para mí.

Tengo una hoja para introducir datos que posteriormente son volcados/copiados a otra hoja. Necesito establecer el recorrido de las celdas en la introducción de los datos, obligando al usuario a pasar por las celdas y no olvidarse la introducción de datos. El recorrido de las celdas debe ser: D6-B10-C10-D10-G10-H10-D12-D13-C16-C17-C18-C19-E16-E17-E18-E19-G16-G17-G18-G19-I16-I17

He buscado por todo el foro y no he sabido encontrar una solución viable.

Alguno sabe como solucionar este pequeño problema.

Gracias anticipadas.

Un Saludo

Xavi

[German]

Hola xavi, como primera propuesta se me ocurre que bloquees la hoja marcando unicamente a la hora de bloquear la pestaña "Seleccionar celdas desbloqueadas" así únicamente podrás escribir en esas, si escribes en la primera y das a enter ira a la segunda, pero eso sí, no te asegura que haya escrito en todas, a lo mejor eso podrías hacerlo con la validación de datos, pero no estoy seguro.

Saludos, Germán.

[xavima]

Hola German,

Un error en mi mensaje anterior, la hoja está bloqueada por macro y las celdas están habilitadas. Lo que busco es que el usuario recorra las celdas de la forma indicada y no según el órden establecido al pulsar Intro.

Xavi

[Antoni]

Estoy en ello pero es bastante laborioso.

Espero tener algo mañana a última hora.

A ver si a alguien se le ocurre alguna fórmula maravillosa o termina esta macro.

Está hecha la navegación en los rangos D6-B10-C10-D10-G10.

En este caso no haría falta bloquear las celdas.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


Application.EnableEvents = False



If Application.Intersect(Target, ActiveSheet.UsedRange) Is Nothing Then

   ActiveSheet.Range("D6").Select

   Application.EnableEvents = True

   Exit Sub

End If



If Not Application.Intersect(Target, ActiveSheet.Range("A1:C6")) Is Nothing Or _

   Not Application.Intersect(Target, ActiveSheet.Range("D1:I5")) Is Nothing Then

   ActiveSheet.Range("D6").Select

   Application.EnableEvents = True

   Exit Sub

End If



If Not Application.Intersect(Target, ActiveSheet.Range("E6:I9")) Is Nothing Or _

   Not Application.Intersect(Target, ActiveSheet.Range("A7:I9")) Is Nothing Or _

   Not Application.Intersect(Target, ActiveSheet.Range("A10")) Is Nothing Then

   ActiveSheet.Range("B10").Select

   Application.EnableEvents = True

   Exit Sub

End If



If Not Application.Intersect(Target, ActiveSheet.Range("E10:F10")) Is Nothing Then

   ActiveSheet.Range("G10").Select

   Application.EnableEvents = True

   Exit Sub

End If



Application.EnableEvents = True



End Sub



[/CODE]

[tese1969]

Propongo alguna solución del tipo............me creo una lista con las celdas en orden en un rango "lejano" u oculto......para el usuario y a partir de ese listado voy activando (a través de eventos) las celdas una tras otra tras producirse una modificación en la previa y solo si esta se produce......puedo señalarla en color o de alguna manera para que sea más fácil entender el proceso....mientras no se produzca el cambio no se mueve ni el ratón!!!.....jejejeje

Esa es la teoría.............si os gusta, en un pis-pas Macro Antonio la traduce en algo tangible.......jejejeje........ya que había empezado el hombre a pegarse con el código..........

Un saludo a todos,

Tese

[chkenshin]

hola amigos buena noche, tomando en cuenta la recomendación de tese1969 me trabaje este pequeño código.

pruebalo y nos cuentas como te funciona

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


Dim arr

Dim rpr As Long

Dim a As Long, b As Long

Dim rng As Range


Application.EnableEvents = False



arr = Array("$D$6", "$B$10", "$C$10", "$D$10", "$G$10", "$H$10", "$D$12", "$D$13", "$C$16", "$C$17", "$C$18", "$C$19", "$E$16", "$E$17", "$E$18", "$E$19", "$G$16", "$G$17", "$G$18", "$G$19", "$I$16", "$I$17")


For rpr = LBound(arr) To UBound(arr)

    If Target.Address = arr(rpr) Then

        a = 1

        Exit For

    End If

Next


If a = 1 Then


    Application.EnableEvents = True


Else

    Do

        b = b + 1

        If b > UBound(arr) Then

            Set rng = Range(arr(0))  'en esta parte debería de llamar la parte donde se ejecuta tu código

            rng.Select

            Application.EnableEvents = True

            Exit Sub

        End If

        On Error Resume Next

        If Range(arr(b - 1)).Value = "" Then

            Set rng = Range(arr(b - 1))

            rng.Select


            Application.EnableEvents = True

            Exit Sub

        End If

        On Error GoTo 0

    Loop While rng Is Nothing

End If

End Sub[/CODE]

[xavima]

Hola,

Gracias por los aportes. Lo probaré esta noche (si el peque de la casa me presta mi portátil). Una observación, en el punto dónde indicas "en esta parte debería de llamar..." yo tengo establecido que el código se ejecuta cuando el usuario pulsa un botón asignado a la macro, mientras no se efectúa operación alguna. Por lo que debo entender que sino indico nada tu código sigue funcionando.

Os informo.

[chkenshin]

hola xavima, ese comentario lo puse pensando que al terminar el recorrido y todo este lleno se ejecutaría otro procedimiento, pero si no le cambias nada se queda como en la hoja actual