Sering sekali kita menerima atau menemukan file excel kita
berukuran yang sangat besar namum isi nya hanya sedikit, dan sangat tidak masuk
akal. Isi yang sedikit tapi dengan Size bisa mencapai 5-10 MB.
Lalu bagaimana cara mengatasinya, banyak sekali caranya,
misalkan dengan melakukan Save As ke .html, .csv format. Tapi hal ini pernah
saya lakukan dan tidak berhasil dengan sempurna.
Tulisan ini mengajak kita untuk menyelesaikan masalah diatas
dengan menggunakan VBA. Pasti akan timbul pertanyaan, apakah setiap file yang
bermasalah akan menggunakan VBA, berarti kita akan selalu mengetikkan code jika
menemui file yang bermasalah. Tentu jawaban nya tidak, kebayang jika kita
memiliki 100 user dan 50% dari user sering mengalami masalah ini. Oleh karena
kita akan membuat Add-Ins (.xla), dan akan di distribusikan ke user.
Ikuti langkah-langkah berikut :
Create New Excel file dan simpan dengan nama Reduce
Pada jendela excel, tekan Alt+F11 (untuk membuka jendela
Visual Basic Editor)
Pada jendela VBA, klik kanan VBA Project (Reduce) dan Insert
> Module
Pada Module ketikkan sintaks seperti dibawah
Option Explicit
Sub Reduce
Dim LastRow As Long
Dim LastCol As Long
Dim ColFormula As Range
Dim RowFormula As Range
Dim ColValue As Range
Dim RowValue As Range
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each ws In Worksheets
With ws
On Error Resume Next
Set ColFormula = .Cells.Find(What:="*",
After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious)
Set ColValue = .Cells.Find(What:="*",
After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious)
Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"),
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlPrevious)
Set RowValue = .Cells.Find(What:="*",
After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlPrevious)
On Error GoTo 0
If ColFormula Is Nothing Then
LastCol = 0
Else
LastCol = ColFormula.Column
End If
If Not ColValue Is Nothing Then
LastCol = Application.WorksheetFunction.Max(LastCol,
ColValue.Column)
End If
If RowFormula Is Nothing Then
LastRow = 0
Else
LastRow = RowFormula.Row
End If
If Not RowValue Is Nothing Then
LastRow = Application.WorksheetFunction.Max(LastRow,
RowValue.Row)
End If
.Range(Cells(1, LastCol + 1).Address &
":IV65536").Delete
.Range(Cells(LastRow + 1, 1).Address &
":IV65536").Delete
End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox ("Selesai")
End Sub
Simpan. Lalu Save As file tersebut dengan type .xla
(Microsoft Office Excel Add-In) dengan nama Reduce.xla
Lalu bagaimana menggunakan nya, buka file yang bermasalah ,
dan Klik Tools > Add-Ins. Pada jendela Add-Ins aktifkan check box Reduce.
Jika tidak ada cari (browse) dimana sewaktu kita menyimpan file .xla nya. (Ini
dilakukan cukup sekali pada setiap PC). Dan untuk menjalankan nya, klik Tools >
Macro > Macros
Jika pada jendela Macro tersedia “Reduce” Macro maka tinggal
klik button Run, jika belum ketikkan “Reduce” pada Macro Name dan klik Run.
Setelah ada pesan “Selesai”. Tutup dan lihat size nya sudah berkurang..
Selamat mencoba ..
Wassalam
Tidak ada komentar:
Posting Komentar