Suprimir cuadraditos en un texto importado

Hola,
Tengo una bases de datos mysql y lo he importado excel mediante una odbc. Una celda contien varios correos electrónicos. Mi objetivo es lograr separar los correos en columnas distintas. El resto de campos se deberán repetir para cada uno de los correos que aparezcan.
El primer problema que surigió es que excel inserta caracteres especiales entre correos electrónicos de la celda. Estoy intentado suprimir los cuadraditos y sustituirlos por comas. Salen dos cuadtraditos entre cada correo electrónico. Encontré esta función en internet:
Dim c
For Each c In Range("A1")
For i = 1 To 31
Application.StatusBar = c.Address & " " & i
On Error Resume Next
Range(c.Address) = Application.Substitute(c, Chr(i), ",")
'Err.Clear
'Resume
Next
Range(c.Address) = Application.Substitute(c, Chr(127), ",")
Range(c.Address) = Application.Substitute(c, Chr(129), ",")
Range(c.Address) = Application.Substitute(c, Chr(141), ",")
Range(c.Address) = Application.Substitute(c, Chr(143), ",")
Range(c.Address) = Application.Substitute(c, Chr(144), ",")
Range(c.Address) = Application.Substitute(c, Chr(157), ",")
Next
Application.StatusBar = False
Solo me funciona con un número limitado de caracteres. Al importar he aumentado el tamaño de la celda para que quepan todos los correos, puede que ese sea el problema.
También me surgió la idea de combinar esta función con la de separa en varias columnas. Para ello encontré esta función en internet:
Range("A1").Select
'Ocultamos el procedimiento para que no se vea en pantalla
'nada de lo que hacemos
Application.ScreenUpdating = False
'Mientras encontremos datos en la fila en cuestión,
'que ejecute el macro
Do While Not IsEmpty(ActiveCell)
'Primero nos fijaremos en qué celda estamos,
'para volver a ella una vez arreglada la fila
dondeestoy = ActiveCell.Address
'Descomponemos la cadena, en subcadenas,
'para lo cual indicamos el delimitador " ", aunque
'por defecto, podríamos haberlo omitido, pues es ese mismo (espacio)
datos = Split(ActiveCell, ",,")
For i = 0 To UBound(datos)
'ponemos cada dato del array, en una columna
ActiveCell.Offset(0, 1) = datos(i)
'nos desplazamos a la columna adyacente (de la derecha)
ActiveCell.Offset(1, 0).Select
Next 'Seguimos con el bucle
'Volvemos donde estábamos inicialmente
Range(dondeestoy).Select
'pasamos a la fila siguiente, y volvemos a recorrer el bucle
ActiveCell.Offset(1, 0).Select
Loop
'Mostramos todo de nuevo
Application.ScreenUpdating = True
No conozco bien como programar en vba. No logro combinar estas dos funciones de eliminar cuadraditos y a la vez dividir en columnas distintas las información.
No se me ocurren más ideas por las que explorar. Habrá seguro otras soluciones.
No se si he logrado explicarme bien,
un saludo y gracias

2 respuestas

Respuesta
1
Los caracteres no imprimibles no solo 127, 129, 141, 143, 144 y 157 los del 1 al 31 también pueden dar el cuadrito.
Gracias, he realizado el cambio pero mi sigue surgiendo el mismo problema. Al haber importado la información forzando más caracteres en la celda, no funciona la macro...
Yo creo que el error está en el for i=1 to 31. He puesto muchos número cada vez mayores y no funciona.
Lo que tampoco entiendo es porque al eliminar las filas de substitue sigue funcionando...
Dim c
For Each c In Range("A1")
For i = 1 To 31
Application.StatusBar = c.Address & " " & i
On Error Resume Next
Range(c.Address) = Application.Substitute(c, Chr(i), ",")
'Err.Clear
'Resume
Next
Range(c.Address) = Application.Substitute(c, Chr(1), ",")
Range(c.Address) = Application.Substitute(c, Chr(2), ",")
Range(c.Address) = Application.Substitute(c, Chr(3), ",")
Range(c.Address) = Application.Substitute(c, Chr(4), ",")
Range(c.Address) = Application.Substitute(c, Chr(5), ",")
Range(c.Address) = Application.Substitute(c, Chr(6), ",")
Range(c.Address) = Application.Substitute(c, Chr(7), ",")
Range(c.Address) = Application.Substitute(c, Chr(8), ",")
Range(c.Address) = Application.Substitute(c, Chr(9), ",")
Range(c.Address) = Application.Substitute(c, Chr(10), ",")
Range(c.Address) = Application.Substitute(c, Chr(11), ",")
Range(c.Address) = Application.Substitute(c, Chr(12), ",")
Range(c.Address) = Application.Substitute(c, Chr(13), ",")
Range(c.Address) = Application.Substitute(c, Chr(14), ",")
Range(c.Address) = Application.Substitute(c, Chr(15), ",")
Range(c.Address) = Application.Substitute(c, Chr(16), ",")
Range(c.Address) = Application.Substitute(c, Chr(17), ",")
Range(c.Address) = Application.Substitute(c, Chr(18), ",")
Range(c.Address) = Application.Substitute(c, Chr(19), ",")
Range(c.Address) = Application.Substitute(c, Chr(20), ",")
Range(c.Address) = Application.Substitute(c, Chr(21), ",")
Range(c.Address) = Application.Substitute(c, Chr(22), ",")
Range(c.Address) = Application.Substitute(c, Chr(23), ",")
Range(c.Address) = Application.Substitute(c, Chr(24), ",")
Range(c.Address) = Application.Substitute(c, Chr(25), ",")
Range(c.Address) = Application.Substitute(c, Chr(26), ",")
Range(c.Address) = Application.Substitute(c, Chr(27), ",")
Range(c.Address) = Application.Substitute(c, Chr(28), ",")
Range(c.Address) = Application.Substitute(c, Chr(29), ",")
Range(c.Address) = Application.Substitute(c, Chr(30), ",")
Range(c.Address) = Application.Substitute(c, Chr(31), ",")
Range(c.Address) = Application.Substitute(c, Chr(127), ",")
Range(c.Address) = Application.Substitute(c, Chr(129), ",")
Range(c.Address) = Application.Substitute(c, Chr(141), ",")
Range(c.Address) = Application.Substitute(c, Chr(143), ",")
Range(c.Address) = Application.Substitute(c, Chr(144), ",")
Range(c.Address) = Application.Substitute(c, Chr(157), ",")
Next
Application.StatusBar = False
Hola,
Me he dado cuenta que he escrito una tontería. El for cumplía la labor de cambiar los cuadraditos de del 1 al 31 por comas.
El problema va a ser un tema del range de la celda. Al haber importado más caracteres de los que al principio dejaba dentro de una celda es donde debe de haber dejado de funcionar.
¿Se te ocurre una posible slución?
Si claro si ya está en el for para que repetirlo, pero bueno si solo está en la celda A1, como se ve en el código de la macro, puedes ensayar algo como =Limpiar(A1)
Si quieres seguir trabajando con tu macro entonces quedaría mejor así:
...
Sub macroLimpiar()
Dim c
For Each c In Range("A1")
    For i = 1 To 31
        Application.StatusBar = c.Address & " " & i
        On Error Resume Next
        Range(c.Address) = Application.Substitute(c, Chr(i), ",")
        'Err.Clear
    Next
Next
Range(c.Address) = Application.Substitute(c, Chr(127), ",")
Range(c.Address) = Application.Substitute(c, Chr(129), ",")
Range(c.Address) = Application.Substitute(c, Chr(141), ",")
Range(c.Address) = Application.Substitute(c, Chr(143), ",")
Range(c.Address) = Application.Substitute(c, Chr(144), ",")
Range(c.Address) = Application.Substitute(c, Chr(157), ",")
Application.StatusBar = False
End Sub
... O podrías imp´lementar la función Limpiar en código y trabajar para toda una selección (rango seleccionado)
.............................
Sub macroLimpiar2()
For Each celda In Selection
   celda.Value = WorksheetFunction.Clean(celda.Value)
Next
End Sub
...
Éxitos no olvides calificar y cerrar la pregunta...
Hola,
Mi problema no lo he encontrado en el foro, siento si está repetida.
He intentado lo que me sugieres pero no me funciona.
Mi objetivo es separa las frases en distintas columnas de excel. Es decir, cuando encuentre un cuadradito que lo escriba en otra columna.
La función limpiar elimina el cuadradito y quita los espacios entre las frases, impidiendo poder distinguir cuando hay que cambiar de columna.
Claro pero puedes combinar la macro cambiando unos cuadros por comas y luego con limpiar eliminar los restantes y luego utilizar algo como texto en columnas.
Postea una línea de ejemplo y así identificamos los cuadros que hay que remplazar y cuál sería la mejor forma de hacerlo.
Hola,
Como te comenté, funciona cuando en una celda hay hasta 256 caracteres, si supera deja de funcionar. No te puedo enseñar la línea de código porque al hacer copy-paste ya no aparece (se convierte en una salto de línea)
¿Cómo se puede cambiar los cuadrados por comas?
Muchas gracias!
Intenta con este código... lo probé sobre una cadena de 422 caracteres...
...
Sub OtraForma()
For i = 1 To 31
    ActiveCell.Value = Replace(ActiveCell.Value, Chr(i), ",")
Next
ActiveCell.Value = Replace(ActiveCell.Value, Chr(127), ",")
ActiveCell.Value = Replace(ActiveCell.Value, Chr(129), ",")
ActiveCell.Value = Replace(ActiveCell.Value, Chr(141), ",")
ActiveCell.Value = Replace(ActiveCell.Value, Chr(143), ",")
ActiveCell.Value = Replace(ActiveCell.Value, Chr(144), ",")
ActiveCell.Value = Replace(ActiveCell.Value, Chr(157), ",")
End Sub
Respuesta
1
Vayamos por partes para entender bien el problema. Cuando dices que una celda contiene varios correos, te refieres a varias direcciones o a todo el texto, cabecera... de varios correos. La cantidad de caracteres en una celda está limitada y te puede impedir la carga correcta. Si es así, el problema estaría en la exportación.
Por otro lado, los "cuadritos" es como representa Excel algunos caracteres no imprimibles, pero no necesariamente todos corresponden al mismo carácter. En tu código cambias por coma algunos caracteres pero no todos, por lo que los que quedan simplemente son otros. Que te salgan dos al final tiene toda la pinta de ser caracteres de final de línea (CR y LF).
Este código te cambia todos los caracteres de una cadena que no están entre el espacio y el "cuadrito" (127) por ;. También se carga ñ, letras acentuadas... Puedes modificarlo para que la sustitución sea por otro carácter o para no cambiar algunos caracteres por encima del 127 que te hagan falta.
Function  As String
Dim i As Integer
Dim cb() As Byte
cb() = StrConv(c, vbFromUnicode) 'genera el array de bytes
For i = 0 To UBound(cb)
If (cb(i) < 20) Or (cb(i) > 126) Then 'ojo. cambia las ñ, letras acentuadas...
cb(i) = 59 ' equivale a punto y coma(";")
End If
Next i
SinCuadritos = cb()
End Function 
En tu código tendrías que borrar todos los Range(c.Address) = Application.Substitute(c, Chr(xxx), ",") del final y dejar
Range(c.Address) =  SinCuadritos(c)
Por último, no sé como haces la importación con el odbc, pero seguramente te interesa exportar a cvs e importar en Excel delimitando por algún carácter (comas, puntos y coma...) Ello te dejaría en cada celda una dirección de email, si es eso lo que necesitas.
Hola,
Muchas gracias por tu respuesta. Ahora entiendo mejor el el código. Nunca he programado con vba, entonces tengo muchas dudas de principiante.
He escrito lo siguiente, o por lo menos es lo que he entendido:
Function Botón1_Haga_clic_en()
'
' Botón1_Haga_clic_en Macro
'
For Each C In Range("C1")
    Range(C.Address) = SinCuadritos(C)
Next
'
End Function
Sub SinCuadraditos As String
Dim i As Integer
Dim cb() As Byte
cb() = StrConv(C, vbFromUnicode) 'genera el array de bytes
For i = 0 To UBound(cb)
If (cb(i) < 20) Or (cb(i) > 126) Then 'ojo. cambia las ñ, letras acentuadas...
cb(i) = 59 ' equivale a punto y coma(";")
End If
Next i
SinCuadritos = cb()
End Sub
Debo estar haciendo algo mal. La función inicial me funcionaba cuando había hasta 256 caracteres en una celda, pero cuando hay más caracteres es cuando deja de funcionar.
Muchas gracias de nuevo!
p.d. Me refería a direcciones de correo electrónico (emails).
Lo que te proponía era mantener tu procedimiento tal y como estuviera y cambair esta parte:
Next
Range(c.Address) = Application.Substitute(c, Chr(127), ",")
Range(c.Address) = Application.Substitute(c, Chr(129), ",")
Range(c.Address) = Application.Substitute(c, Chr(141), ",")
Range(c.Address) = Application.Substitute(c, Chr(143), ",")
Range(c.Address) = Application.Substitute(c, Chr(144), ",")
Range(c.Address) = Application.Substitute(c, Chr(157), ",")
Next
por esta otra:
Next
Range(c.Address) = SinCuadritos(c)
Next
Dejando la función Caudraditos como está, aunque ahora veo que la definición no estaba completa, no sé por qué si la copié. La correcta es:
Function SinCuadraditos (c as String) As String
Dim i As Integer
Dim cb() As Byte
cb() = StrConv(c, vbFromUnicode) 'genera el array de bytes
For i = 0 To UBound(cb)
  If (cb(i) < 20) Or (cb(i) > 126) Then 'ojo. cambia las ñ, letras acentuadas...
         cb(i) = 59 ' equivale a punto y coma(";")
  End If
Next i
SinCuadritos = cb()
End Function 
Disculpa el error de copiado y dime si así te funciona.
Hola,
Muchas gracias por la aclaración. Me sale el siguiente error:
El tipo de argumento ByRef no coincide
En esta línea de código:
Range(c.Address) = SinCuadritos(c)
La c no es un String como está en la función a la que llama.
Function SinCuadritos(c As String) As String
El problema es que tampoco entiendo bien que es el c de la función principal:
Dim c
For Each c In Range("C1")
Un saludo
Ah. El c en la función principal no está definido o sea que es un Variant (cualquier cosa). Luego al usarlo en el bucle for pasa a ser una celda, y luego hace un truco para ir cambiando basado en la dirección de la celda. Pero una celda es una matriz de muchas cosas y por defecto se usa el valor, es decir Range("C1") es lo mismo que Range ("C1"). Value. Al pasar a la función debería funcionarte, ya que hay conversión automática de tipos.
Por cierto he encontrado otro fallo al copiar la función (no tiene que ver con lo primero). Esta, espero que la definitiva, es:
Function SinCuadritos(ByVal c As String) As String
Dim i As Integer
Dim cb() As Byte
Dim res As String
cb() = StrConv(c, vbFromUnicode) 'genera el array de bytes
For i = 0 To UBound(cb)
If (cb(i) < 20) Or (cb(i) > 126) Then 'ojo. cambia las ñ, letras acentuadas...
cb(i) = 59 ' equivale a punto y coma(";")
End If
Next i
res = StrConv(cb(), vbUnicode)
SinCuadritos = res
End Function 
En tu caso solo si lo que vas a mirar está en las celdas A1 hasta A31, queda mejor en mi opinión algo como:
Sub MiFormato () 'o el nombre que quieras para tu macro
Dim s as String
Dim i as Integer 
For i= 1 to 31
   s = Cells(i, 1). Value 'Tomas el valro de s ' recorre la columna A desde A1 hasta A31
   s= Cuadritos (s)  'Devuelve s sin cuadritos
   Cells(i,1).Value = s 'lo vuelve a copiar donde estaba
 next i
 end sub
Otra posibilidad puesto que SinCuadritos es una función, es usarla directamente en una celda escribiendo por ejemplo en B1: =SinCuadritos(A1)
Y luego arrastrar por todas las celdas de la columna para que se te copie. En este caso el problema es que hay que insertar una columna porque si lo escribes en A1 se crea un error por referencia circular.
Bueno, dime si con esto se resuelve o si no, envíame un fichero de ejemplo y te hago la macro sobre él.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Abrir txt con macros

Espero puedas apoyarme con mi problema, debo crear un excel en el cual en la hoja1 entre otras cosas tenga un boton cuya tarea es abrir un archivo txt y copiar su contenido en la hoja2 del excel creado, el problema es que no tengo idea de como hacer...
1 respuesta

Rellenar con 0

Ojala me puedan ayudar, bueno tengo el siguiente problema, necesito rellenar con 0 desde la izquierda, lo he hecho de la siguiente manera =1000000000000000+A1 y luego extraigo. Pero el problema es cuando tengo numeros con decimales. Ejm. Tengo 420 y...
1 respuesta

Contar celdas llenas con programa vba

Tengo una duda respecto al bucle for al cual estoy usando para mostrar por medio de un modulo el msgbox de las distintas celdas llenas con datos, pero la cantidad de celdas llenas las calculo usando una fórmula =contara(A:A) desde la hoja excel y con...
1 respuesta

Insertar datos con un textbox multiline en un varias celdas

En un userform tengo un textbox con la propiedad multiline activada, el cual le ingreso estos datos : BBFL916401 BBFL126301 BBFK951301 BBFK085401 BBFJ715901 BBFJ422901 BBFJ437701 BBFH821301 A veces pueden ser mas de 20, el caso es que también tengo...
4 respuestas

Macro que copie encabezado de una hoja a otra

Sigo en la novatez con vba pero poco a poco le agarro el gusto a este lenguaje, sin embargo sigo topándome con cuestiones como ésta que les platico: Tengo un libro, donde en cada hoja que tiene algunas filas coloreadas, bien, estoy trabajando con una...
1 respuesta

Buscar datos en rejilla

Tengo un control msflexgrid cargado de datos, y me gustaría saber como puedo hacer una búsqueda de una determinada cadena de caracteres o de datos numéricos en la rejilla.
2 respuestas

Llenas una matriz usando otra sin repetir datos

Tengo un arreglo con valores 8|8|8|8|9|8|8|1|1 Por ejemplo Ahora lo que necesito es guardar los valores en otro arreglo pero sin repetirse Es decir que quede 8|9|1 El primer arreglo es dinámico por lo que el segundo también puede variar no se como...
1 respuesta

Posición de celdas con un texto

Tenía esta macro desarrollada para que me informe la posición de las celdas en las que contiene un texto buscado: Sub buscar_cosas() On Error Resume Next Application.ScreenUpdating = False Range("J:K").Clear 'Esto debería ser variable... (sólo sirve...
1 respuesta