makasih pak mrkid. telah dipelajari, dan akan tetap dipelajari agar bisa dikembangkan sendiri untuk solusi atas kasus2 yang mirip. sekali lagi makasih :) imam sinurat
________________________________ Dari: Mr. Kid <[email protected]> Kepada: BeExcel <[email protected]> Dikirim: Selasa, 14 Mei 2013 12:04 Judul: Re: Re: [belajar-excel] Border Formatting - Makro Maaf baru sempat balas. diurutkan prosesnya lagi ya. 0. deklarasi (sepertinya sudah ok) Dim rngData As Range Dim rangenya_kolom3 As Range Dim rngDiProses As Range Dim rngAwalMerge As Range Dim lRec As Long, r As Long 1. persiapan data (sumber) dan lokasi kerja (lokasi hasil) yang bunyinya : With Sheet1 'Lokasi Utak-atiknya dipindah agar data aslinya tidak terganggu:: copast range g5 ke range s5 .Range("g5:j25").Copy Destination:=.Range("s5") 'initialisasi data Set rngData = .Range("s8").CurrentRegion lRec = rngData.Rows.Count - 1 Set rangenya_kolom3 = rngData.Resize(lRec, 1).Offset(1, 2) Set rngAwalMerge = rngData.Offset(1, 2).Resize(1, 1) End With >> persiapan 1 adalah menyiapkan lokasi kerja (hasil), yaitu menghapus semua >> hasil yang lama lokasinya di range s8 (header lokasi kerja yang bersinggungan dengan record data hasil) .Range("s5").currentregion.offset(1).delete xlshiftup >> persiapan 2 menyalin data sumber ke lokasi kerja (sudah ada) di bagian : 'Lokasi Utak-atiknya dipindah agar data aslinya tidak terganggu:: copast range g5 ke range s5 .Range("g5:j25").Copy Destination:=.Range("s5") >> persiapan 3 inisialisasi area kerja 'initialisasi data Set rngData = .Range("s8").CurrentRegion lRec = rngData.Rows.Count - 1 Set rangenya_kolom3 = rngData.Resize(lRec, 1).Offset(1, 2) >> persiapan 4 menyatakan bahwa saat akan dimulai, jumlah cell yang harus >> di-merge adalah 0 (kan belum mulai proses per record) r=0 >> persiapan 5 menyatakan bahwa saat akan dimulai, range awal yang harus >> di-merge belum ada (kan belum mulai proses per record) set rngAwalMerge=nothing End With karena variabel rngAwalMerge dipesan (dim) dalam prosedur, maka persiapan 5 ini ndak perlu ada. Artinya, baris yang berbunyi Set rngAwalMerge = rngData.Offset(1, 2).Resize(1, 1) juga ndak perlu ada (dihapus saja) 2. Proses setiap record data yang butuh di-merge (loop) yang bunyinya : 'loop setiap range di kolom 3 For Each rngDiProses In rangenya_kolom3 'didalam loop ada tahap cek isi range yang sedang diproses oleh loop (pada contoh for each diatas adalah cek isi rngDiProses) 'jika ada isinya, maka lakukan : If rngDiProses.Value <> "" Then '1. merge cell dari cell awal diperluas sebanyak variabel jumlah cell 'rngAwalMerge.Resize(variabel_ jumlah_cell).Merge r = rngDiProses.Rows.Count rngAwalMerge.Resize(r).Merge '2. beri border dobel dibawah range yang sedang diproses oleh loop (misal di rngDiProses), 'tetapi mulai kolom ke-1 (offset 2 kolom kekiri) yang diperluas 1 baris x sekian kolom data rngAwalMerge.Offset(0, -2).Resize(, 4).Borders(xlEdgeBottom).LineStyle = xlDouble '3. set cell awal merge baru (untuk blok merge berikutnya) 'Set rngAwalMerge = rngDiProses Set rngAwalMerge = rngDiProses '4. set ulang jumlah cell kembali ke 1 karena cell awal merge yang baru adalah cell pertama yang dimerge untuk blok merge tersebut 'jika tidak ada isinya alias kosong, maka lakukan : '1. penambahan jumlah cell yang harus di-merge dengan 1 Else rngAwalMerge.Resize(r + 1).Merge End If 'sampai akhir loop, yaitu di baris Next Next rngDiProses >> proses 1 : membuat awal blok loop (sudah ok) 'loop setiap range di kolom 3 For Each rngDiProses In rangenya_kolom3 >> proses 2 : cek range yang diproses ada isinya atau tidak (cukup ok) 'didalam loop ada tahap cek isi range yang sedang diproses oleh loop (pada contoh for each diatas adalah cek isi rngDiProses) 'jika ada isinya, maka lakukan : If rngDiProses.Value <> "" Then 'bisa juga dengan IF LenB(rngdiproses.value)<>0 THEN >> proses 3 : cek lagi, jika range di proses ada isinya, harus melakukan merge >> pada hasil pemeriksaan sebelumnya atau tidak --> tentu saja tandanya adalah isi nilai r. Kalau nilai r > 0, maka ada yang harus di-merge (minimal 1 cell) IF r>0 then >> proses 4 : kalau r>0 (ada yang harus di-merge), maka pastilah rngawalmerge >> ada isinya. --> maka bisa lakukan merge mulai dari rngawalmerge sebanyak r baris (diperluas) rngawalmerge.resize( r , 1 ).merge >> proses 5 : selesai merge lakukan border pada baris sebelum baris range yang >> diproses, karena baris yang diproses ini sudah baris awal merge baru akibat >> ada isinya --> jadi harus lompat 1 baris ke atas lalu lompat ke kolom 1 alias 2 kolom ke-kiri dari range yang diproses, kemudian diperluas sebanyak 1 baris dan sekian banyak kolom tabel hasil (misal 4) rngdiproses.offset(-1,-2).resize( 1,4).borders(xledgebottom).linestyle=xldouble --> karena borders double itu butuh garus yang tebal maka diset garis bordernya tebal (thick) rngdiproses.offset(-1,-2).resize( 1,4).borders(xledgebottom).weight=xlthick >> proses 6 : selesai cek berdasar keharusan melakukan merge (akibat nilai >> dalam variabel r) endif >> proses 7 : karena proses pada cells sebelum range di proses sudah selesai >> (dengan melakukan merge dan pasang border double), maka set ulang isi range >> awal merge dan jumlah baris yang harus di merge (minimal 1 karena range yang >> diproses butuh dimerge) set rngawalmerge=rngdiproses r=1 >> proses 8 : seluruh kondisi saat range di proses ada isinya sudah selesai, >> maka sekarang kondisi jika rngdiproses tak ada isinya (kosong) ELSE >> proses 9 : pada saat rngdiproses kosong (pada area blok ELSE) --> tentu yang terjadi adalah melakukan pernyataan bahwa cell kosong itu harus dimerge bersama rngawalmerge nantinya kalau sudah tahu persis sampai dimana cell kosong itu. --> artinya, jumlah cell yang harus di-merge bertambah 1. Jadi nilai variabel r harus ditambah 1. r=r+1 >> proses 10 : seluruh kondisi berdasar isi range yang diproses sudah selesai endif >> proses 11 : seluruh proses terhadap range yang diproses selesai, jadi >> loopnya bisa ke rngdiproses berikutnya next rngdiproses 3. Proses setelah loop (setelah proses nomor 2) yang bunyinya : 'setelah selesai, lakukan merge dari cell awal merge yang ada sebanyak jumlah cell yang tercatat 'kemudian akhiri dengan memasang border dobel untuk sisi bawah (xledgebottom) dari seluruh area data yang ada rngData.Borders(xlEdgeBottom).LineStyle = xlDouble >> Proses 1 : merge item kolom ke-3 yang terakhir yang ada isinya --> setelah proses loop, didapat kondisi bahwa pada nilai kolom ke-3 terakhir yang ada isinya, tidak di-merge karena tidak ada kegiatan merge yang dilakukan oleh loop sampai semua baris kosong setelahnya diperiksa. --> untungnya, masih diketahui bahwa rngawalmerge ada isinya dan jumlah cell yang harus di-merge ada nilainya, yaitu di variabel r --> maka dilakukan proses merge akhir disini, dengan dipastikan bahwa r>0 (pasti ada yang harus di-merge) IF r>0 THEN rngawalmerge.resize(r,1).merge endif >> Proses 2 : setelah merge terakhir, juga harus mem-border double. --> proses mem-border double pada baris akhir data tidak tergantung nilai variabel r. Oleh sebab itu tidak diletakkan dalam blok IF r>0 THEN diatas (Bagian 3. Proses 1) --> rngdiproses terakhir saat keluar dari blok loop adalah range pada baris terkahir data, maka dari rngdirposes ini harus ke kolom 1 (lompat 2 kolom ke kiri) lalu diperluas 1 baris dan sejumlah kolom data (misal 4) untuk proses pemberian border double yang harus dengan garis tebal. rngdiproses.offset( 0 , -2 ).resize( 1,4).borders(xledgebottom).linestyle=xldouble rngdiproses.offset( 0 , -2 ).resize( 1,4).borders(xledgebottom).weight=xlthick *** ---------------- *** Sepertinya begitu bunyinya. Kalau ada yang error pun, sepertinya sudah cukup mudah untuk diuatk-atik tanpa perlu melototin monitor (nanti ndak monitornya takut kalau dipelototin terus). Wassalam, Kid. 2013/5/13 Imam Sinurat <[email protected]> > > >Yth. Pak MrKid > >Terima kasih responnya. >Step-step solusi arahan bpk sangat menarik, alur fikirnya mudah dicerna. >Saking fahamnya saya dgn uraian bpk, saya sempat operkonpidens kalo ini mudah >utk saya bereskan sendiri. >Ternyata saya msh kesulitan men-translate 'bahasa manusia' ke 'bahasa mesin >VBA'. >Belasan jam begadang melototin monitor, Makronya bisa dieksekusi, tapi >hasilnya msh semrawut. Akhirnya saya Nyerah :D >Mohon bpk koreksi dmn letak kesalahannya (sekaligus kunci jwbnnya dah ya) >hehe.. Makasih sblmnya. > >Wassalam >Imam Sinurat > >Option Explicit > >Sub MergedanBorder() > >Dim rngData As Range >Dim rangenya_kolom3 As Range >Dim rngDiProses As Range >Dim rngAwalMerge As Range >Dim lRec As Long, r As Long > >With Sheet1 >'Lokasi Utak-atiknya dipindah agar data aslinya tidak terganggu:: copast range >g5 ke range s5 >.Range("g5:j25").Copy Destination:=.Range("s5") > >'initialisasi data >Set rngData = .Range("s8").CurrentRegion >lRec = rngData.Rows.Count - 1 > >Set rangenya_kolom3 = rngData.Resize(lRec, 1).Offset(1, 2) >Set rngAwalMerge = rngData.Offset(1, 2).Resize(1, 1) >End With > > >'loop setiap range di kolom 3 > For Each rngDiProses In rangenya_kolom3 > > >'didalam loop ada tahap cek isi range yang sedang diproses oleh loop (pada >contoh for each diatas adalah cek isi rngDiProses) >'jika ada isinya, maka lakukan : > If rngDiProses.Value <> "" Then > > >'1. merge cell dari cell awal diperluas sebanyak variabel jumlah cell > 'rngAwalMerge.Resize(variabel_jumlah_cell).Merge >r = rngDiProses.Rows.Count >rngAwalMerge.Resize(r).Merge > > >'2. beri border dobel dibawah range yang sedang diproses oleh loop (misal di >rngDiProses), >'tetapi mulai kolom ke-1 (offset 2 kolom kekiri) yang diperluas 1 baris x >sekian kolom data > rngAwalMerge.Offset(0, -2).Resize(, 4).Borders(xlEdgeBottom).LineStyle = xlDouble > > >'3. set cell awal merge baru (untuk blok merge berikutnya) > 'Set rngAwalMerge = rngDiProses >Set rngAwalMerge = rngDiProses > > >'4. set ulang jumlah cell kembali ke 1 karena cell awal merge yang baru adalah >cell pertama yang dimerge untuk blok merge tersebut > >'jika tidak ada isinya alias kosong, maka lakukan : >'1. penambahan jumlah cell yang harus di-merge dengan 1 > Else >rngAwalMerge.Resize(r + 1).Merge > >End If > > >'sampai akhir loop, yaitu di baris Next > Next rngDiProses > > >'setelah selesai, lakukan merge dari cell awal merge yang ada sebanyak jumlah >cell yang tercatat > >'kemudian akhiri dengan memasang border dobel untuk sisi bawah (xledgebottom) >dari seluruh area data yang ada > rngData.Borders(xlEdgeBottom).LineStyle = xlDouble > >End Sub > >------------------------------ >Pada Sab, 11 Mei 2013 11:09 Waktu Terang Hari Pasifik Mr. Kid menulis: > > >>Sepertinya Pak Imam akhir-akhir ini sedang giat belajar VBA ya.. > >gimana jika garis besar prosesnya saja dulu ya.......
