kepada: ysh. Pak Eko Wahyudi (thread-maker) dimohon jangan merasa terganggu karena posting ini tidak saya tujukan kepada anda, melainkan untuk keperluan pembelajaran *makro/vba excel bagi members yg **sedang mulai ber-makro-ria* * * *[image: Mergecells bersyarat.PNG] * * * Coding yg sudah ada itu masih dapat di ringkas sbb
Sub MergeCellBersyarat() ' coded by: siti Vi / Oct 26, 2011 ' Merge cells yg valuenya sama ' sebelumnya, Range haru sudah diSelect ' short-cut = Ctrl+Shift+M '-------------------------------- Dim X As Range, c As Integer Set X = Selection(1, 1) Application.DisplayAlerts = False * Do* * c = WorksheetFunction.CountIf(Selection, X)* * X.Resize(1, c).Merge* * Set X = X(1, c + 1)* * Loop Until Len(X) = 0* Application.DisplayAlerts = True End Sub Di sini perbedaanya adalah * Variable 'Blok' yg akan mewakili SelectedRange tidak dipakai lagi, karena object range tsb tidak akan terlalu banyak dirujuk dan ekspresi-nya pun sudah cukup pendek (that is ="*Selection*") * syarat *Penghentian Loop* di letakkan di bagian Loop *UNTIL (SYARAT)* bukan lagi di tengah loop seperti sebelumnya * pemfilteran dengan IF tidak diberlakukan lagi, karena kita berasumsi bahwa Range 'Selection' (berupa sebaris cells) yg di-select untuk diproses, semua berisi data; tidak ada cell yang kosong. * variable integer *c* di tiap akhir step, tidak perlu di reset ( *c*= 0), karena di awal step sudah pasti diperbarui dengan nilai ex Countif(Selection, X) Sedangkan *prinsip-kerja-*nya tetap sama, yaitu : ( berupa rangkaian actions /tindakan tiap step dlm Loop ) 0. Di awal proses, sebelum Loop, Cell pertama (object range) diingat dlm variable *X* 1. di dlm Selecttion dicari: *ada berapa cell* yg mempunyai nilai (isi) sama ? Cacah data yg samadengan isi X diingat dlm variable integer *C* 2. Range X diperluas (resize) menjadi selebar *C *(*kolom* x 1 row), sembari *langsung di MERGE!* 3. Variable object X di set baru dengan Cell yg letaknya ada di *Letak Semula* tapi "pakai acara" *digeser ke kanan sebannyak C + 1* kolom. (=yaitu cell pertama SETELEH sekelompok cells sebaris yg baru saja di Merge) 3 (tiga) tindakan ini diulang-ulang (*Do - Loop*) Until (sampai) terdeteksi Range X = berupa cell kosong... Hal kecil yg sudah lumrah, tetapi semoga menjadi penyemangat mereka yg baru mencebur ke sungai VBA yg jernih dan segar menyenangkan.. cmiiw ~siti On Thu, Oct 27, 2011 at 12:50 AM, STDEV(i) <[email protected]>wrote: > *Listing Code nya:* > * > * > Sub MergeCellBersyuarat() > ' coded by: siti Vi / Oct 26, 2011 > ' meMerge cell yg valuenya sama > ' kiboar short-cut = Ctrl+Shift+M > '-------------------------------- > Dim Blok As Range, X As Range, c As Integer > Set Blok = Selection: Set X = Selection(1, 1) > Application.DisplayAlerts = False > *Do* > c = WorksheetFunction.CountIf(Blok, X) > If c > 0 Then > X.Resize(1, c).Merge > Set X = X(1, c + 1): c = 0 > *If Len(X.Value) = 0 Then Exit Do* > End If > *Loop* > Application.DisplayAlerts = True > End Sub > > *Menjalannya:* > Blok-lah range yg akan diproses (misal: range *E5:BD5*) > lalu tekan tombol *Ctrl + Shift + M* > * > * > ~siti > >
<<Mergecells bersyarat.PNG>>
ctv_MergeCells Yg Values nya sama (V2).xlsb
Description: Binary data
