He visto que una pregunta frecuente es acerca de cómo reducir el tamaño de un archivo. Bueno, hay una causa en específico que puede afectar considerablemente el tamaño de un archivo: El rango de celdas que Excel guarda como usado en cada hoja.
Se puede encontrar fácilmente la última celda del rango usado presionando Ctrl+Fin en cualquier hoja. El problema es que en muchos casos la 'última celda' está mucho más allá del rango 'real' de celdas usadas... esto por lo general se debe a aplicar formatos a celdas que luego no se van a usar, lo que hace que luego Excel guarde esas celdas como parte del rango usado y así crece 'misteriosamente' el tamaño del archivo.
Este problema en particular me llamó la atención porque he visto muchos archivos que se suben en servidores por fuera del foro porque son demasiado grandes para adjuntarlos acá, pero al abrirlos en algunos casos he visto que son archivos con pocos datos, pero con tamaños descomunales... esto debido a que se está guardando como rango usado en cada hoja una cantidad considerable de celdas que no hacen parte del rango 'real' usado.
Bueno, no sé si la explicación sea clara. En todo caso, pensando en algunos de esos casos, escribí esta macro que deberá ayudar a reducir considerablemente el tamaño de dichos archivos 'limpiando' el rango usado y dejando sólo del tamaño del rango 'real' usado.
Esta es el código:
Edito: La macro que propuse inicialmente, gracias a los aportes de quienes han participado en este tema, ha sido mejorado. Para evitar confusiones, copio acá el código final:
Sub Limpiar_rangos()
Dim hj As Excel.Worksheet
Dim copia$, ffin&, cfin&, TI&, TF&
copia = crear_copia(ActiveWorkbook)
MsgBox "Se ha creado una copia: " & vbLf & copia, vbInformation
With ActiveWorkbook
TI = VBA.FileLen(.FullName)
For Each hj In .Worksheets
ffin = 1
cfin = 1
With hj
On Error Resume Next
ffin = .UsedRange.Find(what:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
cfin = .UsedRange.Find(what:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
On Error GoTo 0
If .ProtectContents Then
If MsgBox("La hoja " & .Name & " se encuentra protegida." & vbLf & vbLf & _
"No se podrán limpiar los rangos de esta hoja a menos que se desproteja." _
& vbLf & vbLf & "¿Desea desprotegerla antes de continuar?", vbYesNo, _
"¡Hoja protegida!") = vbYes Then
If Desproteger(hj) Then
Limpiar hj, ffin, cfin
Else
MsgBox "No se ha desprotegido la hoja.", vbCritical, "¡Clave incorrecta!"
End If
End If
Else
Limpiar hj, ffin, cfin
End If
End With
Next hj
.Save
TF = VBA.FileLen(.FullName)
End With
MsgBox "Tamaño original: " & VBA.Format(TI, "#,##0") & " bytes." & vbLf & vbLf & _
"Tamaño final: " & VBA.Format(TF, "#,##0") & " bytes." & vbLf & vbLf & _
"El archivo se redujo en: " & VBA.Format(TI - TF, "#,##0") & " bytes" & _
" (" & VBA.FormatPercent(Abs(TI / TF - 1), 2) & ")."
End Sub
Private Sub Limpiar(ByVal hj As Excel.Worksheet, ByVal ffin As Long, ByVal cfin As Long)
With hj
With .Range(.Cells(ffin + 1, 1), .Cells(.Rows.Count, 1)).EntireRow
If .MergeCells = False Then .Clear
End With
With .Range(.Cells(1, cfin + 1), .Cells(1, .Columns.Count)).EntireColumn
If .MergeCells = False Then .Clear
End With
End With
End Sub
Private Function crear_copia(ByVal Libro As Excel.Workbook) As String
With Libro
.Save
crear_copia = .Path & Application.PathSeparator & VBA.Format(VBA.Now, "d-m-yy h-mm ") & .Name
.SaveCopyAs crear_copia
End With
End Function
Private Function Desproteger(ByVal hj As Excel.Worksheet) As Boolean
On Error Resume Next
hj.Unprotect
Desproteger = Not VBA.CBool(Err.Number)
On Error GoTo 0
End Function[/CODE]
¡Hola a todos!
He visto que una pregunta frecuente es acerca de cómo reducir el tamaño de un archivo. Bueno, hay una causa en específico que puede afectar considerablemente el tamaño de un archivo: El rango de celdas que Excel guarda como usado en cada hoja.
Se puede encontrar fácilmente la última celda del rango usado presionando Ctrl+Fin en cualquier hoja. El problema es que en muchos casos la 'última celda' está mucho más allá del rango 'real' de celdas usadas... esto por lo general se debe a aplicar formatos a celdas que luego no se van a usar, lo que hace que luego Excel guarde esas celdas como parte del rango usado y así crece 'misteriosamente' el tamaño del archivo.
Este problema en particular me llamó la atención porque he visto muchos archivos que se suben en servidores por fuera del foro porque son demasiado grandes para adjuntarlos acá, pero al abrirlos en algunos casos he visto que son archivos con pocos datos, pero con tamaños descomunales... esto debido a que se está guardando como rango usado en cada hoja una cantidad considerable de celdas que no hacen parte del rango 'real' usado.
Bueno, no sé si la explicación sea clara. En todo caso, pensando en algunos de esos casos, escribí esta macro que deberá ayudar a reducir considerablemente el tamaño de dichos archivos 'limpiando' el rango usado y dejando sólo del tamaño del rango 'real' usado.
Esta es el código:
Edito: La macro que propuse inicialmente, gracias a los aportes de quienes han participado en este tema, ha sido mejorado. Para evitar confusiones, copio acá el código final:
Sub Limpiar_rangos() Dim hj As Excel.Worksheet Dim copia$, ffin&, cfin&, TI&, TF& copia = crear_copia(ActiveWorkbook) MsgBox "Se ha creado una copia: " & vbLf & copia, vbInformation With ActiveWorkbook TI = VBA.FileLen(.FullName) For Each hj In .Worksheets ffin = 1 cfin = 1 With hj On Error Resume Next ffin = .UsedRange.Find(what:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row cfin = .UsedRange.Find(what:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious).Column On Error GoTo 0 If .ProtectContents Then If MsgBox("La hoja " & .Name & " se encuentra protegida." & vbLf & vbLf & _ "No se podrán limpiar los rangos de esta hoja a menos que se desproteja." _ & vbLf & vbLf & "¿Desea desprotegerla antes de continuar?", vbYesNo, _ "¡Hoja protegida!") = vbYes Then If Desproteger(hj) Then Limpiar hj, ffin, cfin Else MsgBox "No se ha desprotegido la hoja.", vbCritical, "¡Clave incorrecta!" End If End If Else Limpiar hj, ffin, cfin End If End With Next hj .Save TF = VBA.FileLen(.FullName) End With MsgBox "Tamaño original: " & VBA.Format(TI, "#,##0") & " bytes." & vbLf & vbLf & _ "Tamaño final: " & VBA.Format(TF, "#,##0") & " bytes." & vbLf & vbLf & _ "El archivo se redujo en: " & VBA.Format(TI - TF, "#,##0") & " bytes" & _ " (" & VBA.FormatPercent(Abs(TI / TF - 1), 2) & ")." End Sub Private Sub Limpiar(ByVal hj As Excel.Worksheet, ByVal ffin As Long, ByVal cfin As Long) With hj With .Range(.Cells(ffin + 1, 1), .Cells(.Rows.Count, 1)).EntireRow If .MergeCells = False Then .Clear End With With .Range(.Cells(1, cfin + 1), .Cells(1, .Columns.Count)).EntireColumn If .MergeCells = False Then .Clear End With End With End Sub Private Function crear_copia(ByVal Libro As Excel.Workbook) As String With Libro .Save crear_copia = .Path & Application.PathSeparator & VBA.Format(VBA.Now, "d-m-yy h-mm ") & .Name .SaveCopyAs crear_copia End With End Function Private Function Desproteger(ByVal hj As Excel.Worksheet) As Boolean On Error Resume Next hj.Unprotect Desproteger = Not VBA.CBool(Err.Number) On Error GoTo 0 End Function[/CODE]Reducir el tamaño de un archivo de Excel
Reducir tamaño archivo.zip