Macro para CALC: Eliminar espacios innecesarios

Guías sobre la hoja de cálculos
Reglas del Foro
Este sub-foro no es para hacer preguntas
Aquí encontrará guías básicas sobre cómo utilizar AOO Calc. Para realizar preguntas sobre estas guías, por favor inicie un nuevo tema en el sub-foro apropiado.

También puede consultar la Documentación disponible sobre Apache OpenOffice

Macro para CALC: Eliminar espacios innecesarios

Notapor PepeOooSevilla » Dom Dic 31, 2017 8:56 am

Hola.

Muchísimas veces tengo que importar datos de archivos de texto (CSV) cuyos campos contienen espacios innecesarios, bien al principio o al final del campo e, incluso, entre palabras.

He programado una pequeña macro que elimina, en CALC, los espacios sobrantes tanto al principio como al final de cada celda dejando un espacio entre palabras. Utiliza expresiones regulares.

Esta macro la guardo en "Mis macros" para tenerla siempre disponible.

El tiempo de ejecución es directamente proporcional al número de celdas a reemplazar, es decir, a mayor número de celdas más tiempo tarda en ejecutarse. Para una hoja de 2000 filas x 20 columnas tarda menos de 3 segundos en un PC con procesador Intel Core i3 (2,13GHz), una memoria RAM de 4 GB y sistema operativo Windows 10 (64 bits).

Código: Seleccionar todo   Expandir vistaContraer vista
REM  *****  BASIC  *****
Option Explicit

Const NUEVA_LINEA As Integer = 13
' ICONOS en MSGBOX
Const ICONO_STOP As Integer = 16
Const ICONO_PREGUNTA As Integer = 32
Const ICONO_EXCLAMACION As Integer = 48
Const ICONO_INFORMACION As Integer = 64
' BOTONES en MSGBOX
Const BOTON_ACEPTAR As Integer = 0
Const BOTON_ACEPTAR_CANCELAR As Integer = 1

Sub EliminarEspaciosInnecesarios()
'Elimina espacios innecesarios tanto al inicio como al final de cada celda
'así como los espacios sobrantes entre palabras (deja un espacio)
   Dim DocCalc As Object
   Dim HojaActiva As Object
   Dim Reemplazar As Object
   Dim Mensaje As String

   On Error Goto TRATAR_ERROR
   DocCalc = ThisComponent
   With DocCalc
      If .supportsService("com.sun.star.sheet.SpreadsheetDocument") Then
         HojaActiva = .getCurrentController().getActiveSheet()
         With HojaActiva
            Reemplazar = .createReplaceDescriptor()
            With Reemplazar
               .SearchString = "^ *"
               .ReplaceString = ""
               .SearchRegularExpression = True
            End With
            .replaceAll(Reemplazar)
            With Reemplazar
               .SearchString = " *$"
            End With
            .replaceAll(Reemplazar)
            With Reemplazar
               .SearchString = "  *"
               .ReplaceString = " "
            End With
            .replaceAll(Reemplazar)
            Mensaje = Chr(NUEVA_LINEA) & "Eliminados todos los ESPACIOS innecesarios." & Chr(NUEVA_LINEA)
            MsgBox Mensaje, BOTON_ACEPTAR + ICONO_INFORMACION, "¡Atención!"
         End With
      End If
   End With
   Exit Sub
TRATAR_ERROR:
   Mensaje = Chr(NUEVA_LINEA) & "Se ha producido un ERROR inesperado." & Chr(NUEVA_LINEA)
   MsgBox Mensaje, BOTON_ACEPTAR + ICONO_STOP, "¡Atención!"
End Sub

Saludos cordiales.
LibreOffice 6.1.5 en Windows 7 / 10
Por favor, utiliza el Foro para tus consultas, no los mensajes privados
Avatar de Usuario
PepeOooSevilla
 
Mensajes: 1014
Registrado: Sab Abr 04, 2009 6:10 pm
Ubicación: Sevilla (España)

Volver a Guías para Calc

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 0 invitados