Re: ]] XL-mania [[ memindahkan data ke sheet lain

 

Di milis sudah sering ada penjelasan (karena ada pertanyaan) mengenai 

MEMFILITER data

( Biasanya judul /subject pertanyaannya "macem-macem" bahkan "aneh-aneh",

tanpa menyadari bahwa keperluannya adalah memFILTER !

Tabel Pak Heri ini juga akan diFIILTER dengan kriteria A, B dan C

(A B dan C adalah data uniq di kolom 1 pada tabe l yg akan difilter)

Hasil Filtering-nya di copykan ke sheet yg senama dengan kriterianya.

Jadi pak Heri bisa menggunakan

1. Auto Filter  (karena filteringnya mash terlalu sederhana)

atau ba juga menggunakan

2. Formula Filter  Ingat formula SMALL(IF bukan ??

Untuk data yg banyak, formula filter tidak terlalu menyenangkan, karena

dia termasuk formula yg bekerja keras (sehingga semakin banyak cell yg 

memuat rumus berat spt itu, semakin lamban kinerja worksheet)

Contoh workbokk yg kita lampirkan disini tidak menggunakan AutoFIlter, 

tidak pula menggunakan Formula Filter, tetapi menggunakan Tombol

sekali ceklik, semua beres (kalau tidak error!)

Jika sheet1, ditambah datanya si Tombol harus dipencet lagi, agar data di

sheets hasil diperbarui.

Saat ini untuk memisahkan data ex sheet1, cukup hanya dipindah ke 3 buah sheet 

penampung (A,B,C)

Seandainya penambahan data di sheet1 termasuk adanya UniqItem baru (misal selain

ada data A, B, C ada juga data baru D, E, F, Q, X dst, si TOmbol tidak akan gemetar

karena dia sudah diberi ProTp maupun S.O.P untuk menghadapi keadaan spt itu.

Sheet baru akan dibuatkan oleh si Tombol, untuk anda (termasuk jika pada saat pertama

kali BELUM ADA Sheet penampung (A,B,C dst..)

Berikut ini code yg mendukung si Tombol agar si Tombol tidak terlalu plonga-plongo..

Sub UnmergeDb()

'-------------------------------------

' modifikasi dari makro STDEV(i) /Apr 2009

' iHaps, 23 Dec 2011

'-------------------------------------

   Dim dTbl As Range, NewTbl As Range, Header As Range

   Dim UniqItem, newSht As Worksheet, sht As Worksheet

   Dim n As Long, r As Long, w As Integer

   Set dTbl = Sheets("Sheet1").Cells(1).CurrentRegion

   Set Header = dTbl.Resize(1, dTbl.Columns.Count)

   Set dTbl = dTbl.Offset(1, 0).Resize(dTbl.Rows.Count - 1, dTbl.Columns.Count)

   UniqItem = LOUV(dTbl.Resize(dTbl.Rows.Count, 1))

   For w = 1 To UBound(UniqItem)

      For Each sht In Worksheets

         Application.DisplayAlerts = False

         If sht.Name = UniqItem(w) Then sht.Delete

         Application.DisplayAlerts = True

      Next sht

   Next w

   For w = 1 To UBound(UniqItem)

      Set newSht = Worksheets.Add

      newSht.Move after:=Sheets(Sheets.Count)

      newSht.Name = UniqItem(w)

      Header.Copy newSht.Cells(1)

      Set NewTbl = newSht.Cells(2, 1)

      r = 0

      For n = 1 To dTbl.Rows.Count

         If dTbl(n, 1) = UniqItem(w) Then

            r = r + 1

            dTbl(n, 1).Resize(1, dTbl.Columns.Count).Copy

            NewTbl(r, 1).PasteSpecial xlPasteValuesAndNumberFormats

         End If

      Next n

      Columns("A:C").EntireColumn.AutoFit

      Cells(1).Select

   Next w

   MsgBox "Kelar deh boss!", 64, ThisWorkbook.Name

End Sub

'------------------------------------

iHaps.-

2011/12/23 Heri Haryanto <heriharyanto@astom.co.id>

Selamat siang xl-mania,

Mohon petunjuknya atas kasus saya dibawah ini, mungkin udah pernah dibahas, cumin saya cari2 gak ketemu kira2 keyword nya apa.

Akhirnya saya minta petunjuk langsung aja

 

1	Mau memindahkan data di sheet1, ke sheet A, B dan C
2	di sheet A berisi data sheet1 yang kol1 nya A
3	di sheet B berisi data sheet1 yang kol1 nya B
4	di sheet C berisi data sheet1 yang kol1 nya C.
	Jika ada tambahan data di Sheet1, maka akan menambah data di sheet A, B atau C

 

File terlampir, Terimakasih sebelumnya

 

Heri Haryanto

PT. Astom Indonesia

__._,_.___

Reply to sender | Reply to group | Reply via web post | Start a New Topic

Messages in this topic (2)

Recent Activity:

• New Members 58

Visit Your Group

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| ayooo... coba cari XL-mania di linkedin.com                       |
| momods kebanyakan e-mail :(... unread di kantor 6 ribu lebih :(   |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message,  melecehkan,  tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan  winzip  jika  perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke  |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/           |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau...  |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html           |
+-------------------------------------------------------------------+
| Message lama ada di :                                             |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id]  |
| http://www.mail-archive.com/xl-mania@yahoogroups.com              |
+-------------------------------------------------------------------+

MARKETPLACE

Stay on top of your group activity without leaving the page you're on - Get the Yahoo! Toolbar now.

Switch to: Text-Only, Daily Digest • Unsubscribe • Terms of Use

.

__,_._,___