Terima kasih atas jawabanannya. Pak Kid sudah sesuai dengan yang saya kehendaki.
Tapi untuk dapat memahami cara kerja nya mungkin saya masih butuh semingguan. Salam Lukman 2012/11/3 Mr. Kid <[email protected]> > ** > > > Asumsinya, data inputan seperti dalam sheet coba_proses > Kemudian sheet tersebut diproses dengan menjalankan prosedur bernama > 'Proses' > > Bunyi prosedur Proses adalah : > Public Sub Proses() > Dim shtDT As Worksheet > Dim rngDT As Range, rngLoopDT As Range > Dim rngRef As Range, rngLoopRef As Range > Dim rngLibur As Range > Dim sDTSek As String, sDTAcc As String, sDTKode As String > Dim dtDTTglTr As Date > Dim dblRefFee As Double, dblRefTax As Double > Dim lRefNDay As Long > > 'tentukan sheet yang dikerjakan > 'misal sheet tersebut sedang aktif, maka bis dengan activesheet > 'bisa diganti dengan worksheets("nama sheetnya") > 'atau merujuk nama object seperti Sheet4 seperti : > Set shtDT = Sheet4 > > 'hilangkan baris kosong diantara record data > 'baris kosong membuat dataset tidak berkaidah database > 'asumsi : kolom yang selalu terisi adalah kolom Ticker (kolom E) > 'kolom E adalah kolom ke-5 dalam dataset, karena dataset mulai dari > kolom A > With shtDT > .AutoFilterMode = False 'turn off autofilter > > 'pada area mulai dari a1 sampai cell terakhir data offset 1 > With .Range(.Range("a1"), > .Range("a1").SpecialCells(xlCellTypeLastCell).Offset(1)) > .AutoFilter 5, "=" 'autofilter kolom ke-5 > dalam dataset yang blank > 'dari header lompat 1 ke bawah (offset 1) > 'pilih yang tampak saja (hasil autofilter) > 'dihapus barisnya (entirerow.delete) > .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete > End With > .AutoFilterMode = False 'turn off autofilter > End With > > 'tentukan area data inputan yang sekarang menjadi 1 area data saja > 'karena sudah dihilangkan baris kosongnya > Set rngDT = shtDT.Range("a1").CurrentRegion > > Set rngRef = Sheet5.Range("a1").CurrentRegion > 'tentukan area referensi termasuk header > Set rngRef = rngRef.Offset(1).Resize(rngRef.Rows.Count - 1, 1) 'area > ref tanpa header dan hanya 1 kolom > > Set rngLibur = Sheet5.Range("n1").CurrentRegion.Resize(, 1) 'area > hari libur (1 kolom):kolom pertama > > 'sort hari libur agar ascending (memudahkan formula) > rngLibur.CurrentRegion.Sort rngLibur.Resize(1, 1), xlAscending, > Header:=xlYes > > 'rngllibur dibuat tanpa header > Set rngLibur = rngLibur.Offset(1).Resize(rngLibur.Rows.Count - 1) > > 'loop disetiap cell kolom E mulai record pertama (baris 2 = offset 1 > baris) > 'kolom E adalah lompat 4 kolom (offset 4 kolom) > For Each rngLoopDT In rngDT.Resize(, 1).Offset(1, 4) > With rngLoopDT 'pada range yang sedang > diproses (di kolom E loh ya) > If LenB(.Value) <> 0 Then 'gak blank ? > 'ambil data DT untuk cari nilai di referensi database > sDTSek = UCase$(.Offset(0, -4).Value) 'ada di kolom A > (offset -4 kolom = 4 kolom kekiri dari E) > sDTAcc = UCase$(.Offset(0, -3).Value) 'di kol B > sDTKode = UCase$(.Offset(0, 1).Value) 'di kol F (offset > 1 kolom = 1 kolom kekanan dari E) > dtDTTglTr = .Offset(0, -2).Value > > 'cari di referensi database, untuk kondisi yang sesuai > data DT yang diambil > 'loop selalu berdasar 1 kolom, dan nilai diambil dengan > merujuk ke baris diproses > 'untuk ref, bisa berdasar rngref yang merujuk ke kolom A > dan sudah tanpa header > dblRefFee = 0 > dblRefTax = 0 > lRefNDay = 0 > For Each rngLoopRef In rngRef > With rngLoopRef 'pada range yang diproses (kol > A) > If UCase$(.Value) = sDTSek > Then 'sekuritas sama ? > If UCase$(.Offset(0, 1).Value) = sDTAcc > Then 'No Acc (offset 1 kolom) sama ? > If .Offset(0, 2).Value <= dtDTTglTr > Then 'tgltr data >= tgl berlaku mulai ? > If .Offset(0, 3).Value >= dtDTTglTr > Then 'tgltr data <= tgl berlaku sampai ? > If UCase$(.Offset(0, 4).Value) = > sDTKode Then 'No Acc (offset 1 kolom) ? > 'ambil data referensi > dblRefFee = .Offset(0, 5).Value > dblRefTax = .Offset(0, 6).Value > lRefNDay = .Offset(0, 7).Value > > 'karena sudah dapat, maka > keluar dari loop ref > Exit For > End If > End If > End If > End If > End If > End With > Next rngLoopRef > > 'isi data > '>> ganti dengan hasil UCase > .Offset(0, -4).Value = sDTSek > 'kol A > .Offset(0, -3).Value = sDTAcc > 'kol B > .Offset(0, -1).Value = UCase$(.Offset(0, -1).Value) > 'kol D > .Value = UCase$(.Value) > 'kol E > .Offset(0, 1).Value = sDTKode > 'kol F > > '>> fee (offset 5 kolom) : =ABS(G2) * H2 * %feedb [G : > offset 2 kolom; H : offset 3 kolom] > .Offset(0, 5).Value = Abs(.Offset(0, 2).Value) * > .Offset(0, 3).Value * dblRefFee > > '>> tax (offset 6 kolom) : =ABS(G2) * H2 * %taxdb [G : > offset 2 kolom; H : offset 3 kolom] > .Offset(0, 6).Value = Abs(.Offset(0, 2).Value) * > .Offset(0, 3).Value * dblRefTax > > '>> tgl_jt (offset 8 kolom) : > =Workday(C2,ndaydb,range_liburnas) [C : offset -2 kolom] > .Offset(0, 8).Value = _ > Application.WorksheetFunction.WorkDay(.Offset(0, > -2).Value, lRefNDay, rngLibur) > .Offset(0, 8).NumberFormat = "YYYY-MM-DD" > Else > 'clear kolom fee,tax, dan tgl_jt > 'pemeriksaan dan konfirmasi dapat dilakukan dengan > 'mem-filter kolom fee atau tax atau tgl_jt yang kosong > .Offset(0, 5).ClearContents > .Offset(0, 6).ClearContents > .Offset(0, 8).ClearContents > End If > End With > Next rngLoopDT > End Sub > > Wassalam, > Kid. > > > > > > > 2012/11/2 lkm jktind <[email protected]> > >> ** >> >> >> Mohon maaf. >> sedang berhalangan. >> Baru sempat membalas email saat ini. >> >> Berikut ini : saya kirimkan . lagi contoh file . yg saya kehendaki >> hasil nya seperti si sheet hasil. >> dan mau nya diselesaikan dengan cara loopping. >> >> >> Sebelum nya saya ucapkan terima kasih. >> >> >> Salam Lukman >> >> >> NB : mau mengambil data berapa % fee jual/beli , berapa % Tax dan >> Lamanya tenggang waktu berikut jadwal hari libur . >> Data tersebut ada di sheet database >> >> >> > >
