Ver Mensaje Individual
  #5 (permalink)  
Antiguo 31/03/2008, 02:54
Avatar de 3pies
3pies
Colaborador
 
Fecha de Ingreso: diciembre-2003
Ubicación: Desde una destilería
Mensajes: 2.584
Antigüedad: 20 años, 3 meses
Puntos: 144
Re: Extraer texto de celda en excel con caracteres especiales

Hola mjmontes. Bienvenido al foro.

Prueba este macro (graba tu hoja de cálculo antes de ejecutar el macro, por si las moscas). Con respecto al macro que colgué, solo hay una novedad, y es que tenemos que reemplazar todos los caracteres "raros" por un solo caracter raro, para posteriormente operar con él. Bueno, aquí te dejo el macro para que lo pruebes:
Código:
Sub reorganizar_todo_que_estoy_desesperada_opcion_1()
'********************************************************************************
'Tenemos que situarnos en la primera celda donde tengamos los datos a reorganizar
'Supondremos que es la celda A4
'********************************************************************************
Range("A4").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 ";#"
    ActiveCell = Replace(ActiveCell, "d", ";#")
    ActiveCell = Replace(ActiveCell, "'", ";#")
    ActiveCell = Replace(ActiveCell, """", ";#")
    datos = Split(ActiveCell, ";#")
    For i = 0 To UBound(datos)
        'ponemos cada dato del array, en una columna
        ActiveCell = datos(i)
        'nos desplazamos a la columna adyacente (de la derecha)
        ActiveCell.Offset(0, 1).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
End Sub
Salu2