Mengurangi size pada excel file dengan menggunakan VBA

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 :

1. Create New Excel file dan simpan dengan nama Reduce
2. Pada jendela excel, tekan Alt+F11 (untuk membuka jendela Visual Basic Editor)
3. Pada jendela VBA, klik kanan VBA Project (Reduce) dan Insert > Module
4. 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

5. 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