Validación con macro de varios rangos de columnas diferentes

Recibe un cordial saludos por este medio, Por favor si me pudieras ayudar con una macro para que en el range("A5:A100") forzar a que en esas celdas solo deban ingresar 11 caracteres alfanuméricos en cada una de ellas, range("E5:E100") que puedan ingresar de 1 a 30 caracteres alfanuméricos, range("G5:G100") que solo puedan ingresar la fecha sin guiones ni diagonal por ejemplo 05092013 estas celdas deben tener una longitud de 8 caracteres numéricos y el formato de la celda debe ser tipo texto, Range("H5:H100") este rango de celdas deben tener una longitud de 8 caracteres numéricos y el formato de la celda debe ser texto, en todos los rangos si no se cumple la condición disparar un msgbox

Con la opción de datos -- validación no me funciona ya que si copian y pegan se pierde la validación y formato de la celda

Agradezco de antemano tu valioso tiempo y apoyo

Saludos

1 respuesta

Respuesta
1

Perdona por la tardanza, tenía muchas preguntas por responder. ¿Cuándo te refieres a caracteres alfanuméricos te refieres a todos o solo a las letras y números? Si es to segundo no podría entrar ningún símbolo.

Y cuando dices caracteres numéricos quieres decir cifras o puede haber comas, puntos, signos -, etc.

Disculpa por responder un poco tarde pero es que no tengo casi internet, gracias por responder

Caracteres alfanuméricos son números (0 a 9) y letras (A,B,C...Z)

caracteres numéricos son unicamente números sin comas puntos etc

Saludos

Algún detalle más. ¿Entran las minúsculas o solo las mayúsculas? Y otro detalle bastante importante, ¿Entra el espacio en blanco?

solo mayusculas y no debe de haber espacios en blanco

saludos

Te voy a mandar un fichero para que lo pruebes y me dices si hay que cambiar algo. No está a lo mejor bien del todo no terminado, pero es que tengo que dejar ahora el ordenador unas horas y quiero que lo vayas probando y me dices lo que no esté bien.

El programa se basa en unas variables globales y una macro que esta en la misma hoja donde los datos y unas funciones. Pero ahora no tengo tiempo par explicar, luego si acaso.

Estas son las variables que hay que declarar en un modulo Visual basic

Public Const AlfaMay = "ABCDEFGHIJKLMNÑOPQRSTUVWXYZ"
Public Const AlfaMin = "abcdefghijklmnñopqrstuvwxyz"
Public Const Alfa = AlfaMay & AlfaMin
Public Const Numérico = "0123456789"
Public Const AlfaNum = Alfa & Numérico
Public Const AlfaMayNum = AlfaMay & Numérico
Public Const AlfaMinNum = AlfaMin & Numérico

Y esta es la macro y funciones de la hoja sin indentar porque la página las quita, es inútil indentar las instrucciones.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Celda As Range
Dim Respuesta As Integer
Dim FechaBuena As Boolean
For Each Celda In Target
 If Not Intersect(Celda, Range("A5:A100")) Is Nothing Then
 If Len(Celda) <> 11 And Len(Celda) <> 0 Or Not CadenaValida(Celda, AlfaMayNum) Then
 Celda.Select
 Respuesta = MsgBox("La celda " & Replace(Celda.Address, "$", "") & " debe tener 11 caracteres alfanúméricos (o ninguno)", _
 vbInformation + vbOKOnly, "ERROR EN EL DATO")
 SendKeys "{F2}"
 End If
 ElseIf Not Intersect(Celda, Range("E5:E100")) Is Nothing Then
 If Len(Celda) > 30 Or Not CadenaValida(Celda, AlfaMayNum) Then
 Celda.Select
 Respuesta = MsgBox("La celda " & Replace(Celda.Address, "$", "") & " debe tener de 1 a 31 caracteres alfanúméricos (o ninguno)", _
 vbInformation + vbOKOnly, "ERROR EN EL DATO")
 SendKeys "{F2}"
 End If
 ElseIf Not Intersect(Celda, Range("G5:G100")) Is Nothing Then
 FechaBuena = False
 If Len(Celda) <> 8 Then
 If CadenaValida(Celda, Numerico) Then
 If FechaCorrecta(Celda.Text) Then FechaBuena = True
 End If
 End If
 If Celda = "" Then FechaBuena = True
 If Not FechaBuena Then
 Celda.Select
 Respuesta = MsgBox("La celda " & Replace(Celda.Address, "$", "") & " debe tener una fecha válida de 8 numeros (o ninguno)", _
 vbInformation + vbOKOnly, "ERROR EN EL DATO")
 SendKeys "{F2}"
 End If
 ElseIf Not Intersect(Celda, Range("H5,H100")) Is Nothing Then
 If Len(Celda) <> 8 Or Not CadenaValida(Celda, Numerico) Then
 Celda.Select
 Respuesta = MsgBox("La celda " & Replace(Celda.Address, "$", "") & " debe tener 8 caracteres numéricos (o ninguno)", _
 vbInformation + vbOKOnly, "ERROR EN EL DATO")
 SendKeys "{F2}"
 End If
 End If
Next
End Sub
Private Function CadenaValida(Cadena, CarValidos As String) As Boolean
Dim i As Integer
CadenaValida = True
If Cadena = "" Then Exit Function
For i = 1 To Len(Cadena)
 If InStr(CarValidos, Mid(Cadena, i, 1)) = 0 Then
 CadenaValida = False
 Exit For
 End If
Next
End Function
Private Function FechaCorrecta(Cadena As String) As Boolean
Dim dia, Mes, Año As Integer
dia = Val(Left(Cadena, 2))
Mes = Val(Mid(Cadena, 3, 2))
Año = Val(Mid(Cadena, 5, 4))
FechaCorrecta = False
If Mes = 0 Or Mes > 12 Then Exit Function
If dia = 0 Or dia > 31 Then Exit Function
If dia = 31 And (Mes = 2 Or Mes = 4 Or Mes = 6 Or Mes = 9 Or Mes = 11) Then Exit Function
If dia = 30 And Mes = 2 Then Exit Function
If dia = 29 And Año Mod 4 <> 0 Then Exit Function
If dia = 29 And Año Mod 100 = 0 And Año Mod 400 <> 0 Then Exit Function
FechaCorrecta = True
End Function

Y aquí tienes el libro para descargar, pruébalo pero no es definitivo si hay algún error o quieres alguna modificación.

ValidacionRangosColumnas.xlsm

Muchísimas gracias y disculpa por apenas responder me parece en el rango G y H no corre bien la maccro

Voy a finalizar la pregunta para que puedas contestar otras ya que casi no tengo internet para estar en contacto

Te agradezco tu ayuda Saludos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas