Foro Excel

Que tal compañeros de nueva cuenta quiero pedir apoyo a ver si es posible mejorar la siguiente rutina:

Código: Seleccionar todo

Function DepuraCadenas(xxAsunto As String) As String
Dim Temporal As String
    Temporal = Replace(xxAsunto, "'", "", 1)        ''
    Temporal = Replace(Temporal, ".", "", 1)        '.
    Temporal = Replace(Temporal, Chr$(34), "", 1)   '"
    Temporal = Replace(Temporal, Chr$(42), "", 1)   '*
    Temporal = Replace(Temporal, Chr$(47), "", 1)   '/
    Temporal = Replace(Temporal, Chr$(58), ";", 1)  ':
    Temporal = Replace(Temporal, Chr$(60), "", 1)   '<
    Temporal = Replace(Temporal, Chr$(62), "", 1)   '>
    Temporal = Replace(Temporal, Chr$(63), "", 1)   '?
    Temporal = Replace(Temporal, Chr$(92), "", 1)   '\
    Temporal = Replace(Temporal, Chr$(124), ")", 1) '|

Temporal = Left(Temporal, 40)
DepuraCadenas = Temporal
End Function



Esta rutina trabaja bien, reemplaza ciertos caracteres que no permiten la creacion de un nombre valido para un archivo pero resulta que por la cantidad de nombres es una rutina muy lenta, ademas que deseo ampliar el numero de caracteres a sustituir, no se si de alguna manera se pueda que en vez de ir linea a linea revisando si existe un caracter no deseado estos puedan ir en una matriz y por consiguiente optimizar la depuracion de caracteres. (Espero haberme explicado )

De antemano gracias y saludos desde México D.F.

Hola a mi, se me ocurren dos ideas
1.- No crear una variable temporal

Function DepuraCadenas(byval xxAsunto As String) As String
xxAsunto = Replace(xxAsunto, "'", "", 1) ''
xxAsunto = Replace(xxAsunto , ".", "", 1) '.
xxAsunto = Replace(xxAsunto , Chr$(34), "", 1) '"
xxAsunto = Replace(xxAsunto , Chr$(42), "", 1) '*
xxAsunto = Replace(xxAsunto , Chr$(47), "", 1) '/
xxAsunto = Replace(xxAsunto , Chr$(58), ";", 1) ':
xxAsunto = Replace(xxAsunto , Chr$(60), "", 1) '<
xxAsunto = Replace(xxAsunto , Chr$(62), "", 1) '>
xxAsunto = Replace(xxAsunto , Chr$(63), "", 1) '?
xxAsunto = Replace(xxAsunto , Chr$(92), "", 1) '\
xxAsunto = Replace(xxAsunto , Chr$(124), ")", 1) '|
xxAsunto = Left(xxAsunto , 40)
DepuraCadenas = xxAsunto
End Function

2.- Poner Un Replace dentro de otro, no es muy prolijo

Function DepuraCadenas(ByVal xxAsunto As String) As String
DepuraCadenas = Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(xxAsunto, "'", "", 1), ".", "", 1), Chr$(34), "", 1), Chr$(42), "", 1), Chr$(47), "", 1), Chr$(58), ";", 1), Chr$(60), "", 1), Chr$(62), "", 1), Chr$(63), "", 1), Chr$(92), "", 1), Chr$(124), ")", 1), 40) '.
End Function


Saludos.

Que tal P@li,

Gracias son dos buenos ejemplos, ya los aplique pero como son diferentes longitudes de cadenas y con diferentes caracteres que pienso aumentar la rutina aún así­ es muy lenta y ayer navegando por esta pagina encontre este codigo para que detecta si tienes caracteres no validos

Código: Seleccionar todo

    Dim CarInvalidos As Variant, I As Long
    CarInvalidos = Array(":", "\", "/", "?", "*", "[", "]")
    For I = 0 To UBound(CarInvalidos)
        If InStr(Nombre, CarInvalidos(I)) Then
            MsgBox "El nombre """ & Nombre _
                & """ contiene caracteres invalidos: """ _
                    & CarInvalidos(I) & """."
            NombreValido = False
            Exit Function
        End If
    Next I
    NombreValido = True


No se si esta rutina se pueda utilizar con el array y aplicar a lo que necesito, de antemano gracias por tu apoyo y que tengan todos un buen dí­a!!!

Seguramente se puede usar con array, pero eso no va a acelerar la función, es más yo creo q va a tardar el mismo o más tiempo que la función original que diste.

Saludos

Hola chicos,

jarturo";p="30388 escribió:encontre este codigo para que detecta si tienes caracteres no validos

Dim CarInvalidos As Variant, I As Long
CarInvalidos = Array(":", "", "/", "?", "*", "[", "]")
For I = 0 To UBound(CarInvalidos)
If InStr(Nombre, CarInvalidos(I)) Then
MsgBox "El nombre """ & Nombre _
& """ contiene caracteres invalidos: """ _
& CarInvalidos(I) & """."
NombreValido = False
Exit Function
End If
Next I
NombreValido = True

Je je je!!! Me suena el codigo

A ver esto:

Código: Seleccionar todo

Function LimpiarNombre(Texto As String)
    Dim RegExp As Object
    Set RegExp = CreateObject("vbscript.regexp")
    With RegExp
        .Pattern = "['.""*/:<>?\\|]"
        .Global = True
        LimpiarNombre = .Replace(Texto, "")
    End With
End Function

Para mas informacion sobre Expresiones Regulares:

http://support.microsoft.com/kb/818802/es
http://msdn.microsoft.com/library/defau ... 6a7353.asp
http://www.tmehta.com/regexp/

P@li, Gracias por tu interes en mis preguntas , KL me dio un código muy interesante y creo que el código en el que querí­a apoyarme es de él , nuevamente gracias y espero seguir contando con tu ayuda más adelante .

KL tu código trabaja de pelos!!! y gracias por los links ya tengo tarea para leer y aprender algo más.

Gracias a todos los que crean y hacen posible este excelente foro de aprendisaje, Saludos a todosss!!!