Eliminar caracteres Inválidos en excel

Tengo una problemática con uno de mis usuarios tiene que subir por medio de batch un machote de excel, cuando el captura los datos manualmente comete muy pocos errores y son perceptibles, pero cuando se dedica a copiar de otros orígenes (Word, PDF, Excel, XPS) se copian caracteres como saltos de línea, tabulaciones, comas, " $", etc. Que el usuario no ve.

Lo que necesito me ayuden es a crear una macro que revise toda la hoja y me elimine todo aquello que no sea alfabético o numérico incluyendo dejar el símbolo "/", o bien que me indique la celda en la que esta el error y termine la macro. Para corregirla y volver a correr el proceso.

La verdad estoy bloqueado, ya lo tenia resuelto pero por alguna razón ya no me funciona ni con la macro que me habías proporcionado.

Incluso al final agregue un

Case Else
Range("A1", Cells(uf, uc)).Replace What:=letra, Replacement:="", LookAt:=xlPart
x = x + 1
MsgBox "Proceso Finalizado se realizaron " & x & " sustituciones"

me hace el contador y me dice "x" sustituciones realizadas.

Como te comento ya ni con tu macro me funciona ahora me borra todo el archivo.

:'(

Te dejo datos un ejemplo del archivo.

https://www.dropbox.com/s/upa5x376khnxsvz/Carga%20sicas%20Autos%20logis.xlsx?dl=0 

Respuesta
1

H o l a:

No puedo descargar datos de dropbox, puedes enviarme el archivo con la macro a mi correo.

Mi correo [email protected]

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

¡Gracias! 

Te anexo la macro actualizada, incluí los caracteres, y guión.

Lo que hacía la macro si encontraba el asterisco "*" era reemplazar todo por "", por eso te borraba todo el archivo.

Le hice cambios para que solamente el "*" te lo reemplace por "".

Además en las fórmulas no realizará reemplazos.

Sub LimpiarDatos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    uf = Range("A1").SpecialCells(xlLastCell).Row
    uc = Range("A1").SpecialCells(xlLastCell).Column
    n = 0
    For Each c In Range("A1", Cells(uf, uc)).SpecialCells(xlCellTypeConstants, 23)
        If Not c.HasFormula Then
            For i = 1 To Len(c)
                letra = Mid(c.Value, i, 1)
                If letra = "*" Then
                    letra = "~*"
                End If
                If letra <> "" Then
                    codigo = Asc(letra)
                    Select Case codigo
                        Case 48 To 57                '0123456789
                        Case 65 To 90, 97 To 122     'A-Z, a-z
                        Case 225, 233, 237, 243, 250 'á é í ó ú
                        Case 193, 201, 205, 211, 218 'Á É Í Ó Ú
                        Case 32, 241, 209            'barra espaciadora ñ Ñ
                        Case 44, 45, 46, 47          ', - . /
                        Case Else
                            'Range("A1", Cells(uf, uc)).Replace What:=letra, Replacement:="", LookAt:=xlPart
                            c.Replace What:=letra, Replacement:="", LookAt:=xlPart
                            n = n + 1
                    End Select
                End If
            Next
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Se realizaron " & n & " sustituciones"
End Sub

':)
'S aludos. D a n t e   A m o r . R ecuerda valorar la respuesta. G racias
':)

¡Gracias!

Anexe esta línea al código de sustitución

MsgBox "Se encontro error de captura: " & letra & "en " & c

que tendria que agregar para que me mencione el nombre/ubicación de la celda es decir  

Error en A50

Error en C34

Antes de esta línea:

c.Replace What:=letra, Replacement:="", LookAt:=xlPart

Pon esta línea:

MsgBox "Se encontro error de captura: " & letra & "en " & c.address

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas