kalau dikatakan sebagai proses "tranpose" memang agak benar dikits..
tetapi transpose nya terhadap Area KECIL demi Area KECIL, yg dimensi tiap
AREA nya tidak sama dan tidak dapat di duga (tidak ada pola tertentu,
misalnya dimensi Area yg mau ditranspose jumlah barisnya meningkat dgn
eskalasi tertentu)
Jika ada pola keteraturannya maka mungin RUMUS masih dapat dengan mudah
menyelesaikannya.
Dengan bentuk yg ada sekarang inipun, sebetulnya juga masih dapat diselesaikan
dengan RUMUS (pembentukan tabel summary dengan menuliskan rumus pada
tabel summary tsb)
Daripada pusing mencari URAT keteraturannya, langsung saja pakai makro;
makro punya cara tersendiri dalam mengandle tabel tabel; Tabel yg oleh rumus
dianggap tidak ada pola keteraturannya oleh VBA bisa dibuat Pola keteratuannya.
Keunggulan bhs pemrograman adalah, sambil jalan, dia punya tempat yg banyak sekali
(variable memory) untuk menyimpan hal-hal yg nantinya dapat diakses, diolah dan
dimanipulasikan demi mendapatkan nilai / tercapainya tujuan program.
Hal yg sama hampir dapat dikatakan tidak ada dlm proses membuat RUMUS / FORMULA.
Proses yg ditempuh oleh makro dibawah ini kira kira begini:
** menyusun nilai unik hasil perasan dari data yg ada di Kolom 1 pada Tabel Rujukan
(RefTBL)
Nantinya unik list yg berhasil di ambil akan dijadikan Header pada tabel Report.
/ Tabel Summary atau di makronya siti sebut sbg NewTBL.
** mengadakan kunjungan ke semua baris data pada RefTBL dimulai pada baris data
(record) no.2
Record #1 tidak perlu di ganggu gugat karena dia hanyalah Judul / kolom Heading "doang"...
** dalam setiap kunjungan ke sebuah barisdata (baris data diindex-kan dng variable i)
value di kolom 1 di cek, apakah berupa text = "Event No." ?
Jika ya :
kita meperbesar nilai variable r (r ini akan dipakai untuk mengindex baris pada
tabel penuisan hasil (NewTBL). Kalimat nya sudah terkenal sejak jaman jadul /dBase I
r =r + 1
Jika Tidak :
kita mencari SUATU nilai: yaitu
data ex kolom 1 pada RefTBL itu kan selalu ada kembarannya di Baris Judul / Header
pada NewTBL, ya ndak ??
Bukan isi cell nya yg kita cari tetapi Angka-POSISI nya di baris Judul tsb ada di urutan
ke berapa ? (jawabannya berupa bilangan integer)
Nilai ini kita ingat dlm sebuah variable bilangan integer yg diberinama c.
Nantinya c ini akan dipakai untuk mengindex KOLOM dimana data salinan dari RefTBL
akan dituliskan.
Karena r (index baris) dan c (index kolom) sudah diketahui; maka penulisan data dapat segera
dilakukan
NewTBL(r, 1) = RefTBL(1, 2)
NewTBL(r, c) = RefTBL(i, 2)
NewTBL(r, c) = RefTBL(i, 2)
Pekerjaan seperti diceritak-kan di atas itu diulang terus menerus, sampai semua baris data di
RefTBL mendapat giliran kunjungan dari tim kita.
Hasil penulisan cell demi cell itu ternyata tak lebih (tetapi juga tak kurang) dari tabel keinginan
pak Hadi... (di cek saja kalau "ndak" percaya.. )
Sub ctv_Samerais()
' sitiVi / bluewater, 11 Mei 2011 / solving XL-mania case
' http://tech.groups.yahoo.com/group/XL-mania/message/18293
'----------------------------------------------
Dim RefTBL As Range, NewTBL As Range, Header As Range
Dim UniqItem, c As Integer, i As Long, r As Long
Set RefTBL = Cells(1).CurrentRegion
Set NewTBL = RefTBL.Offset(1, RefTBL.Columns.Count + 3)
UniqItem = LOUV(RefTBL.Resize(RefTBL.Rows.Count, 1))
For i = 1 To UBound(UniqItem)
If UniqItem(i) = 0 Then UniqItem(i) = "Event No."
If UniqItem(i) = 9999 Then UniqItem(i) = "END"
Next i
Set Header = NewTBL(0, 1).Resize(1, UBound(UniqItem))
Header = UniqItem: r = 1
For i = 2 To RefTBL.Rows.Count
If LCase(Left(RefTBL(i, 1), 5)) = "event" Then
r = r + 1
Else
c = WorksheetFunction.Match(RefTBL(i, 1), Header, 0)
NewTBL(r, 1) = RefTBL(1, 2)
NewTBL(r, c) = RefTBL(i, 2)
End If
Next i
' sitiVi / bluewater, 11 Mei 2011 / solving XL-mania case
' http://tech.groups.yahoo.com/group/XL-mania/message/18293
'----------------------------------------------
Dim RefTBL As Range, NewTBL As Range, Header As Range
Dim UniqItem, c As Integer, i As Long, r As Long
Set RefTBL = Cells(1).CurrentRegion
Set NewTBL = RefTBL.Offset(1, RefTBL.Columns.Count + 3)
UniqItem = LOUV(RefTBL.Resize(RefTBL.Rows.Count, 1))
For i = 1 To UBound(UniqItem)
If UniqItem(i) = 0 Then UniqItem(i) = "Event No."
If UniqItem(i) = 9999 Then UniqItem(i) = "END"
Next i
Set Header = NewTBL(0, 1).Resize(1, UBound(UniqItem))
Header = UniqItem: r = 1
For i = 2 To RefTBL.Rows.Count
If LCase(Left(RefTBL(i, 1), 5)) = "event" Then
r = r + 1
Else
c = WorksheetFunction.Match(RefTBL(i, 1), Header, 0)
NewTBL(r, 1) = RefTBL(1, 2)
NewTBL(r, c) = RefTBL(i, 2)
End If
Next i
'------------------------------------------
2011/5/11 <hadi.prayitno80@gmail.com>
Dear XL-mania,
Mau tanya-tanya pada expert semua.. saya kesulitan untuk transpose data, karena datanya banyak lumayan klo di paste special. Selain itu jumlah row nya beda-beda gimana yah caranya? saya lampirkan contohnya.
Sebelumnya saya ucapkan terima kasih atas bantuannya
HADI P
__._,_.___
+-:: XL-mania ::::::::::::::::::::----------------------------------+
| maaf baru moderate sekarang... momods kurang tidur berhari-hari |
| jadi budak kantoooOOooorrr... |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf |
+-------------------------------------------------------------------+
| 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 |
+-------------------------------------------------------------------+
| maaf baru moderate sekarang... momods kurang tidur berhari-hari |
| jadi budak kantoooOOooorrr... |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf |
+-------------------------------------------------------------------+
| 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
.
__,_._,___
Nenhum comentário:
Postar um comentário