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 respuesta
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 Fer” 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
