hehehe...
mungkin mau uji coba yang berikut ini (ndak jamin gak error ya, karena
belum bisa lihat script dalam file lampiran Anda)
dalam text file lalu ada prosedur berbunyi seperti ini :
'melengkapi data source (nyusun max per nama, tulisan nama untuk tampilan,
nilai nominal tampilan, nilai bulan untuk tampilan)
private sub KomputasiDataSource()
dim rngData as Range
dim lRec as Long
set rngData = sheets("_bridge_").range("a1").currentregion
lRec = rngData.rows.count - 1
if lRec < 1 then
exit sub
endif
set rngData = rngData.resize(lRec, 1).offset(1, 7)
with rngData
'formula untuk kolom-kolom tampilan, cek lagi, sapa tahu salah
ambil kolom. Asumsi record mulai A2
.formula = "=vlookup( b2, _myPvtMax_ ,3,0)*f2" 'ambil nilai
max dari pivot table, khusus data yang bln<=10 -> HJns=1
.offset(0, 1).formula = "=b2&if(g2=1,""*"","""")" 'nama diberi *
kalau HUrut=1 (data Nom2) -> HUrut=2 adalah data Nom1
.offset(0, 2).formula = "=if(g2=2,c2,d2)" 'nilai nominal ambil
Nom1 kalau HUrut=2, ambil Nom2 kalau HUrut selain 2
.offset(0, 3).formula = "=right("" ""&e2&if(g2=1,""*"",""
""),3)" 'membuat selalu 3 karakter bln, ada * kalau HUrut=1
.parent.calculate 'kalkulasi
'divalues
.resize(, 4).copy
.resize(, 4).pastespecial xlpastevalues
end with
end sub
diubah menjadi : (yang di-biru adalah tambahan atau pengubahannya)
'melengkapi data source (nyusun max per nama, tulisan nama untuk tampilan,
nilai nominal tampilan, nilai bulan untuk tampilan)
private sub KomputasiDataSource()
dim rngData as Range
dim lRec as Long
set rngData = sheets("_bridge_").range("a1").currentregion
lRec = rngData.rows.count - 1
if lRec < 1 then
exit sub
endif
set rngData = rngData.resize(lRec, 1).offset(1, 7)
with rngData
'formula untuk kolom-kolom tampilan, cek lagi, sapa tahu salah
ambil kolom. Asumsi record mulai A2
rngData.offset(0,-3).name = "_myOBLN_"
'ambil nilai max dari pivot table, khusus data yang bln<=10 ->
HJns=1
.formula = "=if(f2,vlookup( b2, _myPvtMax_
,3,0),-countif(_myOBLN_,"">""&e2))"
.offset(0, 1).formula = "=b2&if(g2=1,""*"","""")" 'nama diberi *
kalau HUrut=1 (data Nom2) -> HUrut=2 adalah data Nom1
.offset(0, 2).formula = "=if(g2=2,c2,d2)" 'nilai nominal ambil
Nom1 kalau HUrut=2, ambil Nom2 kalau HUrut selain 2
.offset(0, 3).formula = "=right("" ""&e2&if(g2=1,""*"",""
""),3)" 'membuat selalu 3 karakter bln, ada * kalau HUrut=1
.parent.calculate 'kalkulasi
'divalues
.resize(, 4).copy
.resize(, 4).pastespecial xlpastevalues
thisworkbook.names("_myOBLN_").delete
end with
end sub
Moga-moga pas perkiraannya. Kalau formula yang dibiru masih belum pas
merujuk kolom OBLN, mohon di-pas-pas-ken
Wassalam,
Kid.
2013/5/1 Imam Sinurat <[email protected]>
> **
>
>
>
> Yth. Pak mrkid
>
> Langkah-langkahnya sudah saya ikuti, dan alhamdulillah saat makronya
> dijalankan TIDAK ada error.
>
> Cuma satu yg terlihat belum pas saat ini, yaitu: record yang kolom (5)
> -nya bernilai >10 belum ter-sort secara descending, masih acak.
>
> Berikut file format .xlsm nya saya lampirkan.
>
> Mohon bimbingan selanjutnya.
>
> Wassalam
> Imam Sinurat
>
> ------------------------------
> Pada Sel, 30 Apr 2013 10:41 Waktu Terang Hari Pasifik Mr. Kid menulis:
>
>
> >Topik ini sudah di-repost berulang kali tapi belum ada yang respon.
> >
> >gini aja, sambil menunggu BeExceller menyusun solusi topik ini, mungkin
> mau
> >sedikit repot mencoba prosedur imajinasi terlampir.
> >
> >Peringatan!!!
> >-> Tidak dijamin bakal sukses tanpa error.
> >
> >Moga-moga ada BeExceller yang bersedia mencobanya (bila perlu
> >memperbaikinya kalau error) terus di posting kemilis workbooknya.
> >
> >Bismillah, moga-moga gak error-error banget
> >1. Syarat yang harus dipenuhi (siapkan dengan baik)
> > gunakan file lampiran dari penanya, jangan diubah sedikit pun [harus
> >masih ting-ting]
> > (bila perlu unduh ulang dulu : ada sheet data dan sheet hasil)
> > buka file dari penanya dan lakukan save as dengan cara :
> > tekan ALT F A -> pada bagian save as type, pilih .xlsm atau
> >.xlsb -> ganti namanya bila perlu -> tekan tombol Save
> > unduh text file terlampir.
> >
> >2. cara pasang text file terlampir ke workbook kerja
> > buka workbook hasil proses 1 (kalau belum terbuka)
> > ke VBE (tekan ALT F11) -> menu Insert -> pilih Module
> > buka text file terlampir dengan NotePad atau semacamnya dan jangan diset
> >Word Wrap
> > copy semua yang ada dalam text file yang terbuka (CTRL A lalu CTRL C)
> > ke VBE lagi, dilembar module baru tadi, lakukan paste (CTRL V)
> > cek baris paling atas, kalau ada baris tulisan option explicit 2 baris,
> >hapus salah satu barisnya
> > kembali ke worksheet (tekan ALT F11)
> > save workbook (harus tipe .xlsm atau .xlsb ya)
> >
> >3. buat tombolnya
> > di sheet data, insert sebuah shape
> > klik kanan shape baru itu -> pilih Assign Macro -> pilih UpdateReport ->
> >tekan OK
> > save workbook lagi
> >
> >4. coba pencet si shape hasil langkah nomor 3 tadi.
> >
> >Insya Allah begitu bisa pakai VBA lagi, saya usahakan posting workbook-nya
> >kalau belum ada BeExceller yang mau mencobanya.
> >Kalau ada error, kabarkan ke milis ya, supaya banyak yang bisa sempat
> >ngecek.
> >
> >Selamat mencoba, dan mohon maaf kalau masih ndak bisa urun yang lebih
> baik.
> >
> >Wassalam,
> >Kid.
> >
> >
> >
> >2013/4/29 Imam Sinurat <[email protected]>
> >
> > **
>
> >
> >
> > Salam be-excel..
> >
> > Yth. para suhu dan rekan2 exceler....
> > Mohon bantuan pencerahan tentang cara men-Sorting Data Gabungan
> > Menggunakan Makro.
> >
> > Keterangan tabel soalnya sbb:
> >
> > 1. Semua "nama yang bersifat unik" di-sort sesuai kolom (5) secara
> > descending.
> >
> > 2. Setiap nama yang sama lalu disusun berkelompok sesuai urutan "nama
> > unik" tadi, dan masing-masing kelompok nama di-sort kembali sesuai kolom
> > (5) secara descending.
> >
> > 3. Hasil sorting untuk record yang kolom (5) -nya bernilai <=10
> > diletakkan pada tabel di deretan atas, sedangkan sisanya di deretan
> bawah.
> >
> > 4. Kolom (3) dan (4) digabungkan dan ditampilkan sekolom (seolah-olah ada
> > penambahan record).
> >
> > Bantuannya dimohonkan sangat, terima kasih sebelumnya.
> >
> > Wassalam
> > Imam Sinurat - Sumut
> >
> >
> >
>
>
>
