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.......
Border_Formatting_Makro.xlsm
Description: Binary data
