Tengo una consulta, he creado 47 registros en una validación de datos, pero me gustaría que se vayan eliminando en cada validac

He creado 47 registros en excel AA01:AA47, ahora en las primeras celdas, le he puesto la funcionalidad de validación de datos, para ir colocando cada uno de los registros donde corresponden, pero me gustaría que las opciones del siguiente registro desasparesca la opción que deje en el anterior.

1 respuesta

Respuesta
1

H o l a:

En las celdas AA1:¿AA47 tienes los datos que cargaste en la lista de validación?

¿Y en cuáles celdas vas a ocupar esa lista de validación?

Vamos a suponer que en el rango B2:B100 vas a poner la funcionalidad de la lista de validación.

Entonces cada que selecciones una celda del rango B2:B100 en automático te mostrará los datos que están disponibles.

Pon la siguiente macro en los eventos de tu hoja:

Private Sub Worksheet_SelectionChange(ByVal target As Range)
'Por.Dante Amor
    If target.Count > 1 Then Exit Sub
    '
    Set celdas = Range("B2:B100")
    If Not Intersect(target, celdas) Is Nothing Then
        Columns("AB").Clear
        j = 1
        For Each r In Range("AA1:AA47")
            existe = False
            For Each c In celdas.SpecialCells(xlCellTypeConstants, 23)
                If c.Address <> target.Address Then
                    If r.Value = c.Value Then
                        existe = True
                        Exit For
                    End If
                End If
            Next
            If existe = False Then
                Cells(j, "AB") = r.Value
                j = j + 1
            End If
        Next
        '
        u2 = Range("AB" & Rows.Count).End(xlUp).Row
        With target.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, Formula1:="=AB1:AB" & u2
            .IgnoreBlank = True: .InCellDropdown = True
            .InputTitle = "": .ErrorTitle = ""
            .InputMessage = "": .ErrorMessage = ""
            .ShowInput = True: .ShowError = True
        End With
    End If
End Sub

Sigue las Instrucciones para poner la macro en los eventos de worksheet

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
  4. Del lado derecho copia la macro

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta. G r a c i a s

‘_

Hola Amigo, me parece muy interesante tu respuesta, de todos modos te adjunto un link, donde he puesto mas o menos la idea, te adjunto un link de un archivo en flash sobre un juego para poder practicar el PMI, pero este es de la versión antiguo, quería ver si lo podía hacer para la nueva versión, esta ves quería manejar lo en un excel

http://intelligentorange.net/images/JuegoMapaV1.swf , este es el link de la versión anterior

http://www.filedropper.com/datosparaexcel y este es el archivo de como me gustaría que quede. si las opciones puede ser aleatorias, pero que no se repita en cuando doy una respuesta positiva, y algún mensaje cuando este mal, te agradezco tu ayuda por tu respuesta que es de mucha utilidad

¿Probaste la macro que te envié?

¡Gracias! si, lo probé y me pareció bien, estoy viendo como adecuarlo a lo que me enviaste

Si es lo que necesitas, recuerda valorar la respuesta.

Si tienes dificultades para adaptarlo a lo que necesitas, entonces envíame tu archivo y me explicas con colores lo que deseas.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “David Lezcano” y el título de esta pregunta.

¡Gracias! 

amigo ya te envié el correo a tu email, te agradezco por tu gran ayuda

Te anexo la macro actualizada para cuando borras todo el rango:

Private Sub Worksheet_SelectionChange(ByVal target As Range)
'Por. Dante Amor
    If target.Count > 1 Then Exit Sub
    '
    Set celdas = Range("c3:g29")
    If Not Intersect(target, celdas) Is Nothing Then
        Columns("AB").Clear
        j = 1
        For Each r In Range("AA1:AA48")
            existe = False
            For Each c In celdas '.SpecialCells(xlCellTypeConstants, 23)
                If c.Address <> target.Address Then
                    If r.Value = c.Value Then
                        existe = True
                        Exit For
                    End If
                End If
            Next
            If existe = False Then
                Cells(j, "AB") = r.Value
                j = j + 1
            End If
        Next
        '
        u2 = Range("AB" & Rows.Count).End(xlUp).Row
        With target.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, Formula1:="=AB1:AB" & u2
            .IgnoreBlank = True: .InCellDropdown = True
            .InputTitle = "": .ErrorTitle = ""
            .InputMessage = "": .ErrorMessage = ""
            .ShowInput = True: .ShowError = True
        End With
    End If
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas