DAM_Abrir Archivo Excel con macro y ejecutar otra que quite espacios

Que tal quisiera que me apoyen con esta consulta, estaba intentando crear una macro que me permita cargar un archivo excel y a la vez limpie los espacios en blanco que puedan tener las celdas, es decir un button que cargue el archivo y otro que limpie la hoja, seria "BotonAbrir" "BotonLimpiar"

1

1 Respuesta

3.693.400 pts. Si me amas, siempre voy a estar en tu corazón; si me...

H o l a:

Puedes enviarme tu archivo y me explicas con detalle lo que necesitas.

Mi correo [email protected]

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

Bueno en realidad no tengo ningún archivo hecho lo que pasa es que recibo hojas de excel con una cantidad inmensa de datos los cuales quisiera cargarlos a una macro la cual pueda borrar los espacios en blanco y los enter que puedan tener cada una de ellas... gracias.

Para saber qué es lo que quieres limpiar, necesito que me envíes un ejemplo.

Entonces me envías un archivo con la información original y con comentarios me explicas qué quieres limpiar. En otro archivo me muestras el resultado que esperas.

Perfecto...mañana te lo envío...

Hola que tal DAM, según tus sugerencias, adjunto el archivo a tu correo para que lo puedas revisar muchas gracias (Y)

Te anexo la macro

Sub AbrirQuitar()
'Por.Dante Amor
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.StatusBar = False
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione archivo de excel"
        .Filters.Clear
        .Filters.Add "Todos los archivos", "*.*"
        .Filters.Add "*xls*", "*.xls*"
        .FilterIndex = 2
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show Then
            Set l2 = Workbooks.Open(.SelectedItems.Item(1))
            Set h2 = l2.Sheets(1)
            Application.StatusBar = "Quitando espacios"
            For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
                If Not IsNumeric(h2.Cells(i, "A")) Then
                    fila = i - 1
                    Exit For
                End If
            Next
            n = 1
            cuantos = h2.Range("A2: AN" & fila).SpecialCells(xlCellTypeVisible).Count
            For Each c In h2.Range("A2: AN" & fila).SpecialCells(xlCellTypeVisible)
                Application.StatusBar = "Limpiando celda: " & n & " de: " & cuantos
                n = n + 1
                c.Value = Evaluate("=TRIM(" & c.Address & ")")
            Next
            l2.Save
            l2.Close
        End If
    End With
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = False
    MsgBox "Fin"
End Sub

Hola que tal, te escribí al correo, espero respuesta, gracias

Macro actualizada:

Sub AbrirQuitar()
'Por.Dante Amor
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.StatusBar = False
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione archivo de excel"
        .Filters.Clear
        .Filters.Add "Todos los archivos", "*.*"
        .Filters.Add "*xls*", "*.xls*"
        .FilterIndex = 2
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show Then
            Set l2 = Workbooks.Open(.SelectedItems.Item(1))
            Set h2 = l2.Sheets(1)
            Application.StatusBar = "Quitando espacios"
            For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
                If Not IsNumeric(h2.Cells(i, "A")) Then
                    fila = i - 1
                    Exit For
                End If
            Next
            n = 1
            On Error Resume Next
            cuantos = h2.Range("A2: AN" & fila).SpecialCells(xlCellTypeVisible).Count
            For Each c In h2.Range("A2: AN" & fila).SpecialCells(xlCellTypeVisible)
                Application.StatusBar = "Limpiando celda: " & n & " de: " & cuantos
                n = n + 1
                c.Value = Evaluate("=TRIM(" & c.Address & ")")
            Next
            On Error GoTo 0
            l2.Save
            l2.Close
        End If
    End With
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = False
    MsgBox "Fin"
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas