Cara Mengumpulkan Daftar Unik dari Kolom Ganda Excel dengan Macro VBA
Daftar kepingan data unik adalah hasil salinan dari suatu daftar kolom tunggal yang berisi kepingan-kepingan data ganda.
Adapun alat yang digunakan untuk menghasilkan salinan tersebut dalam Macro VBA Excel adalah AdvancedFilter.
Penerapannya terlihat seperti pada contoh macro berikut dalam sebuah module, yang tugasnya akan menyalin suatu daftar unik dari kepingan data ganda dari kolom A ke dalam kolom C:
Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("C1"), Unique:=True
End Sub
Jika daftar data unik bisa dihasilkan dari suatu kolom tunggal, bisakah Anda menghasilkan daftar unik tersebut dari suatu tabel data yang terdiri dari banyak kolom yang di dalamnya telah berisi data-data ganda?
Dalam gambar di atas ditunjukkan contoh worksheet yang hanya fiktif belaka yaitu daftar ranking survei sepuluh besar menu favorit pada suatu rumah makan.
Berikut ini langkah-langkah pembuatan kode macro:
1. Siapkan worksheet yang berisi data ganda dengan kolom ganda atau Anda bisa menyalin data contoh seperti pada gambar.
2. Buka VBE dengan menekan Alt+F11.
3. Buat module melalui menu Insert > Module.
4. Tetapkan judul macro misalnya DaftarUnik:
Sub DaftarUnik()
5. Matikan dulu ScreenUpdating supaya macro berjalan cepat dan lancar:
Application.ScreenUpdating = False
6. Tetapkan variabel sebagai berikut:
Dim x As Long, v As Variant
Set t = Range("B4:E13")
x = 2
7. Hapus kolom ketujuh (kolom G) dimana daftar unik dihasilkan:
With Range("G1")
.Value = "Daftar unik:"
.Font.Bold = True
End With
8. Jalankan proses loop For Each...Next untuk setiap sel di dalam barisan sel tabel, lalu tambahkan nilai sel pada daftar jika sebelumnya tidak ditemukan di daftar:
v = Application.Match(s.Value, Columns(7), 0)
If IsError(v) Then
Err.Clear
Cells(x, 7).Value = s.Value
x = x + 1
End If
Next s
9. Hapus variabel objek t dari memori sistem:
Set t = Nothing
10. Anda boleh menambahkan (bukan keharusan) perintah mengurutkan daftar sesuai urutan menurut abjad:
Order1:=xlAscending, Header:=xlYes
11. Sesuaikan lebar kolom G dengan lebar tulisannya:
Columns(7).AutoFit
12. Hidupkan kembali ScreenUpdating:
Application.ScreenUpdating = True
13. Inilah kode macro dengan susunan lengkap:
Application.ScreenUpdating = False
Dim s As Range, t As Range
Dim x As Long, v As Variant
Set t = Range("B4:E13")
x = 2
Columns(7).Clear
With Range("G1")
.Value = "Daftar unik:"
.Font.Bold = True
End With
For Each s In t
v = Application.Match(s.Value, Columns(7), 0)
If IsError(v) Then
Err.Clear
Cells(x, 7).Value = s.Value
x = x + 1
End If
Next s
Set t = Nothing
Range("G1").CurrentRegion.Sort Key1:=Range("G2"), _
Order1:=xlAscending, Header:=xlYes
Columns(7).AutoFit
Application.ScreenUpdating = True
End Sub
14. Buka kembali worksheet dengan menekan Alt+Q
15. Buka kotak dialog Macro dengan cara menekan Alt+F8 lalu pilih DaftarUnik dan klik Run.
Itulah penjelasan tentang bagaimana cara mengumpulkan data unik dari sekumpulan data ganda di dalam kolom yang jumlah kolomnya lebih dari satu.
Selamat mencoba dan semoga postingan ini bermanfaat.