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.......
>
>
>
