Validar "Ñ" y Caracteres Especiales

Estimado estoy realizando una Macro y Necesito ayuda para validar en un rango de celdas en excel las "Ñ" y los caracteres especiales que al momento de presionar el enter si existe dentro del parrafo escrito uno de estos caracteres me muestre un mensaje.

1 Respuesta

Respuesta
1
Pues suponiendo que en el rango A1:A10 de tu hoja, quieres que te salga un Msgbox si escribes alguna palabra con eñe (ñ)
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a1:a10]) Is Nothing Then Exit Sub
If Target Like "*ñ*"  Or Target Like "*Ñ*" Then
MsgBox "Hay una eñe en lo escrito"
End If
End Sub
Abraham
Mil Gracias, Abraham, funciono perfectamente, pero no se si sea posible que en vez de que me muestre el mensaje mejor que cambie las "Ñ" por "N".
Agradeciendo de antemano tu valioso tiempo le saluda.
Feliciano
Prende tu grabadora de macros, ve a EDICION - REEMPLAZAR, reemplza las eñes por enes, diferenciando mayusculas de minusculas, deten tu grabadora de macros. Ya tienes el codigo
Abraham
Gracias Abraham
ya lo hice y me funciona, pero si dentro del rango a buscar y reemplazar me posiciono en una celda y y presiono la tecla "Supr" me da el siguiente error "Run-time error '13': Tipe mismath"
Agradezco tu ayuda para solventar este error.
Pues, para ayudarte mejor, seria bueno ver como te quedo la macro, ¿no crees?
Abraham
La macro me quedo como se muestra a continuación, necesito que la macro me reempalce las letras acentuadas por letras sin acentuar Ejm: "á" por "a", "Á" por "A", "í" por "i", "Í" por "I" etc. y que adicionalmente me valide si dentro del mismo rango existen caracteres especiales Ejm: "~", "¿", Etc. de existir algun caracter especial dentro del rango me muestre un mensaje.
Private Sub Worksheet_Change(ByVal Target As Range)
'Cambiar "Ñ" por "N"
If Intersect(Target, [F19:F52]) Is Nothing Then Exit Sub
Cells.Replace What:="ñ", Replacement:="n", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Ñ", Replacement:="N", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
'Validar Carácteres Especiales
If Intersect(Target, [F19:F52]) Is Nothing Then Exit Sub
If Target Like "*~*" Or Target Like "*¿*" Then
MsgBox "Hay un Cáracter NO Valido en lo Escrito"
Target.Select
End If
Saludos
Considero que se puede mejorar, pero creo que "algo" asi te servira:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Chrespecial As Variant, miarray&
If Intersect(Target, [F19:F52]) Is Nothing Then Exit Sub
Target.Replace What:="ñ", Replacement:="n", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Target.Replace What:="Ñ", Replacement:="N", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Chrespecial = Array(":", "\", "/", "?", "*", "[", "]")
For miarray& = 0 To UBound(Chrespecial)
If InStr(Target, Chrespecial(miarray&)) Then
MsgBox "La celda tiene caracteres especiales que se borraran"
Target.Replace Chrespecial(miarray&), Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Exit Sub
End If
Next miarray&
End Sub
Abraham
Funciona Muy bien, pero como hago para reemplazar las demas letras, puedo repetir esta instrucción tantas veces sea necesario o no
If Intersect(Target, [F19:F52]) Is Nothing Then Exit Sub
Target.Replace What:="ñ", Replacement:="n", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Target.Replace What:="Ñ", Replacement:="N", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
If Intersect(Target, [F19:F52]) Is Nothing Then Exit Sub
Target.Replace What:="á", Replacement:="a", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Target.Replace What:="Á", Replacement:="A", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
por que cuando la repito seis veces y le agrego la istrucción para validar caracteres especiales y me posiciono en una celda ubicada dentro de la referencia me da un error
Chrespecial = Array(":", "\", "/", "?", "*", "[", "]")
For miarray& = 0 To UBound(Chrespecial)
If InStr(Target, Chrespecial(miarray&)) Then
MsgBox "La celda tiene caracteres especiales que se borraran"
'Target.Replace Chrespecial(miarray&), Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Exit Sub
End If
Next miarray&
Gracias por tu tiempo
Abraham, la macro completa me quedo asi, pero como te comente anteriormente, cuando estoy sobre una celda que se encuentre incluida dentro del rango y presiono la tecla "SUPR" me da un error, por favor prueba el codigo para que me ayudes a detectar el error.
Gracias
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Chrespecial As Variant, miarray&
' Cambiar "Ñ" por "N"
If Intersect(Target, [F19:F52]) Is Nothing Then Exit Sub
Cells.Replace What:="ñ", Replacement:="n", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Ñ", Replacement:="N", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
' Cambiar "Á" por "A"
If Intersect(Target, [F19:F52]) Is Nothing Then Exit Sub
Cells.Replace What:="á", Replacement:="a", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Á", Replacement:="A", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
' Cambiar "É" por "E"
If Intersect(Target, [F19:F52]) Is Nothing Then Exit Sub
Cells.Replace What:="é", Replacement:="e", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="É", Replacement:="E", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
' Cambiar "Í" por "I"
If Intersect(Target, [F19:F52]) Is Nothing Then Exit Sub
Cells.Replace What:="í", Replacement:="i", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Í", Replacement:="I", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
' Cambiar "Ó" por "O"
If Intersect(Target, [F19:F52]) Is Nothing Then Exit Sub
Cells.Replace What:="ó", Replacement:="o", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Ó", Replacement:="O", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
' Cambiar "Ú" por "U"
If Intersect(Target, [F19:F52]) Is Nothing Then Exit Sub
Cells.Replace What:="ú", Replacement:="u", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Ú", Replacement:="U", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Chrespecial = Array(":", "\", "/", "?", "*", "[", "]")
For miarray& = 0 To UBound(Chrespecial)
If InStr(Target, Chrespecial(miarray&)) Then
MsgBox "La celda tiene caracteres especiales que se borraran"
Target.Replace Chrespecial(miarray&), Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Exit Sub
End If
Next miarray&
' Validar E28 que sea "=A" para que en F28 se coloque un BIC
If Target.Address(False, False) = "F28" Then
' Controlamos si es A y letras
If Target.Offset(0, -1) = "A" And (IsNumeric(Target.Value) Or Left(Target.Value, 2) = "//") Then
MsgBox "Debe Colocar un Código BIC"
Target.Select
Exit Sub
End If
' Controlamos si es D y <> //
If Target.Offset(0, -1) = "D" And Left(Target.Value, 1) <> "/" Then
MsgBox "Debe Colocar un Número de Cuenta o un Código ABA"
Target.Select
Exit Sub
End If
End If
' Evaluamos si se trata de E32
If Target.Address(False, False) = "F32" Then
' Controlamos si es A y letras
If Target.Offset(0, -1) = "A" And (IsNumeric(Target.Value) Or Left(Target.Value, 2) = "//") Then
MsgBox "Debe Colocar un Código BIC"
Target.Select
Exit Sub
End If
' Controlamos si es D y <> //
If Target.Offset(0, -1) = "D" And Left(Target.Value, 1) <> "/" Then
MsgBox "Debe Colocar un Número de Cuenta o un Código ABA"
Target.Select
Exit Sub
End If
End If
End Sub
Es mucho codigo como para revisartelo todo, pero, sugiero colocar al inicio d ela macro un:
On Error Resume Nect
Para asi "saltarte"los errores
Abraham

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas