Kami haturkan berikut terimakasih atas penjelasannya,
Mungkin saya kurang lengkap menyampaikan permasalahan saya.
Tujuan saya menggunakan macro/vba adalah sebagai berikut :
Berbeda tahun weeknum-nya berbeda-beda saya ingin setiap merubah tahun langsung merge kolom-nya juga mengikuti, (lebih jelasnya bisa view di attachment)
Terimakasih atas perhatian, bantuan solusinya.
Salam
Eko
From: XL-mania@yahoogroups.com [mailto:XL-mania@yahoogroups.com] On Behalf Of STDEV(i)
Sent: 27 Oktober 2011 11:29
To: XL-mania@yahoogroups.com
Subject: Re: ]] XL-mania [[ Merge kolom bersyarat
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
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) <setiyowati.devi@gmail.com> 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
Nenhum comentário:
Postar um comentário