Coba kita kutip programnya (penjelasan tambahan ditulis dengan huruf italic):
Sub splittabel()
' siti Vi + De Premor (edited by HK)
Dim sht As Worksheet
Dim RefTbl As Range
Dim DesTbl As Range
Dim sNames As String, ArrNames
Dim r As Long, n As Long, i As Long, c As Integer
Ini adalah deklarasi variabel (coba lihat dan hapus yang tidak dipakai). Tujuan
Deklarasi Variabel adalah untuk mempercepat proses
Application.DisplayAlerts = False
Ini adalah untuk meniadakan dialog yang ditampilkan oleh komputer pada saat
kita akan mendelete sheet (karena selalu jawabnya Yes)
' hapus sheets selain "DATA MASTER"
For Each sht In ThisWorkbook.Worksheets
If sht.Name <> "DATA MASTER" Then
sht.Delete
End If
Next sht
Untuk menghindarkan conflict apabila nama sheet baru sama dengan yang sudah ada
maka sheet yang ada (selain DATA MASTER) harus dihapus terlebih dahulu
' set tabel
Set RefTbl = Sheets("DATA MASTER").Cells(1, 1).CurrentRegion
Data (RefTbl) yang akan diproses harus diset terlebih dahulu, yaitu sheet DATA
MASTER mulai dari sel A1 (Cells(1,1)) sampai akhir (CurrentRegion)
' creating unique list of Names
For r = 2 To RefTbl.Rows.Count
If InStr(1, sNames, RefTbl(r, 3) & "|") = 0 Then
sNames = sNames & RefTbl(r, 3) & "|"
End If
Next
ArrNames = Split(sNames, "|")
Untuk mencari nama unik diperlukan satu proses perbandingan dengan fungsi InStr
pada kode lokasi (kolom 3). Jika kode lokasi dipindahkan ke kolom 10 maka 3
diganti dengan 10. Jika namanya belum ada (If InStr(1, sNames, RefTbl(r, 3) &
"|") = 0)maka nama tersebut akan ditambahkan pada satu kelompok nama yang
bersifat unik, yaitu sNames. Supaya sNames tersebut menjadi suatu nama yang
berurutan maka sNames displit menjadi ArrNames (dari sononya selalu mulai dari
0)
' isi judul + data
For i = LBound(ArrNames) To UBound(ArrNames) - 1
RefTbl.AutoFilter Field:=3, Criteria1:=ArrNames(i)
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = ArrNames(i)
RefTbl.SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1")
Cells.EntireColumn.AutoFit
RefTbl.AutoFilter
Application.CutCopyMode = False
Next i
Mulai dari ArrNames awal (LBound(ArrNames)) sampai dengan akhir
(UBound(ArrNames) - 1)--->(-1 karena mulainya dari 0),
lakukan langkah2 berikut ini:
- Data (RefTbl) difilter (AutoFilter) pada kode lokasi (Filed:=3, kalau
dipindahkan ke kolom 10 maka 3 diganti 10) dengan kriteria sesuai urutan nama
yang ada pada ArrayNames (Criteria1:=ArrNames(i))
- Tambahkan Sheet baru (Sheets.Add) setelah sheet terakhir
(after:=Sheets(Sheets.Count)
- Beri nama Sheet baru (ActiveSheet) dengan nama (Name) = urutan nama yang ada
pada ArrNames (ArrNames(i))
- Data (RefTbl) yang "tampak" setelah difilter
(SpecialCells(xlCellTypeVisible)) dicopy (Copy) ke Sheet baru Range("A1")
(ActiveSheet.Range("A1"))
- Atur kolom sesuai panjang karakternya (Cells.EntireColumn.AutoFit)
- Hilangkan tanda panah kecil pada judul Data (RefTbl.AutoFilter) sehingga data
kembali seperti sebelum difilter
- Usir semut beriring yang merupakan tanda copy (Application.CutCopyMode =
False)
- Lanjutkan dengan urutan ArrNames berikutnya (next i)
Application.DisplayAlerts = True
Ini adalah untuk menampilkan kembali dialog yang ditampilkan oleh komputer
MsgBox "Selesai BOSS", vbInformation, "KESAN DAN PESAN"
Isi sih perlu ga perlu
End Sub
On Saturday, 30 November 2013, 14:40, Ahmad Syaifullah Lubis
<[email protected]> wrote:
Mr Hk,
pada macro "Memfilter data kemudian memindahkannya ke sheet baru", gimana ya
caranya agar kd_lokasinya digeser ke kolom paling kanan. karena saat saya
pindahkan kd_lokasi dari kolom C ke kolom H tidak bisa dieksekusi. maklum, gak
ngerti banget, kalau bisa programnya diuraikan satu persatu ya, biar saya bisa
memahami arti dari program tsb.
terima kasih,
ASL
________________________________
To: [email protected]
From: [email protected]
Date: Tue, 26 Nov 2013 20:16:30 -0800
Subject: Re: Bls: [belajar-excel] Memfilter data kemudian memindahkan nya ke
sheet baru dengan macro [1 Attachment]
Coba yang ini (kode lokasi aslinya disembunyikan pake data group).
Macronya berasal dari mba Siti dan ide dari Pak De Premor mengenai Autofilter
kemudian saya edit.
Salam,
HK
On Wednesday, 27 November 2013, 10:04, Abah Jambrong <[email protected]> wrote:
masalahnya saya ga bisa programming....bahasa pemrograman yg dulu sy pelajari
adalah pascal dan clipper....kebayang kan jaman batu dah saya belajarnya heheh
Pada , Abah Jambrong <[email protected]> menulis:
kode lokasi nya beda-beda suhu, kan disana ada kode lokasi (misal :
024041003100335000TP) nah sebenarnya contoh data yg kemarin di kirim itu dari
satu lokasi aja ngambil nya dari 10031 (masih ada 40 kode lagi) dengan jml
break down berbeda dan kode 003350 itu adalah break down nya dari 10031 (salah
satunya). dari 40 kode unik td aja break downnya bisa 100 an lbh dengan nilai
nominal triliunan....mata saya jd siwer jadi kalo cara manual kadang2 suka da
satu atau dua baris yg ga ke blok.... makanya saya hanya perlu satu tombol yg
bisa milah / mem-break down dari satu lokasi aja krn lokasi lain kan tinggal
copy paste ke sheet master data trs saya tekan tombol nya, milah otomatis trs
saya save as deh. begitu suhu....maaf penjelasan saya bikin bingung hehehe
Pada Rabu, 27 November 2013 8:30, Mr. Kid <[email protected]> menulis:
boleh tanya dulu ya ?
1. nama-nama sheetnya akan berubah-ubah setiap harinya ? ataukah sebenarnya
tetap ?
>> jika tetap (misal pasti seluruh kode itu ada 150 bijik) bisa
memanfaatkan pivot table yang di-copy dan sudah diatur layout terfilternya
sebanyak jumlah kode itu.
2. boleh tahu kenapa kok dipisah-pisah ke banyak sheet ?
3. sudah coba search di milis tentang kasus yang mirip ?
Wassalam,
Kid.
2013/11/26 Abah Jambrong <[email protected]>
>
>uuupppss maaaf ternyata ukuran file lampirannya >250kb.... berikut saya
>kirimkan kembali lampirannya, terima kasih
>
>
>
>Pada Selasa, 26 November 2013 16:03, hendrik karnadi
><[email protected]> menulis:
>
>
>Pada prinsipnya bisa, tinggal nunggu lampirannya.
>
>
>Salam,
>HK
>
>
>
>On Tuesday, 26 November 2013, 15:51, "[email protected]" <[email protected]>
>wrote:
>
>
>saya sehari-hari bekerJa dengan data yg jumlah nya ratusan bahkan ribuan baris
>dengan kode yg berbeda beda, saya mohon bantuannya karena ga bisa programming,
>selama ini saya harus melalui sort dulu terus di blok secara manual
>kadang-kadang ada 1 atau 2 baris yg terlewat.
>maksud saya bisa ga dengan satu tombol macro memfilter data kode lokasi (kode
>unik nya) di kelompokan terus secara otomatis pula data yg sudah di filter
>langsung pindah ke sheet baru dengan nama sheet kode lokasi tersebut....
>berikut saya lampirkan contoh data nya.... saya ucapkan terima kasih banyak
>atas bantuannya
>
>--- Mods ---
>File lampiran yang melebihi 250KB dilepas dari email. Mohon pengirim mengirim
>ulang file lampiran yang lebih sesuai peraturan milis (max 250KB).
>Untuk sampai saat ini, mohon dipelihara lebih dulu peraturan milisnya, sampai
>ada pemberitahuan baru tentang kenaikan kuota file lampiran.
>---------------
>
>
>
>
>
