Mungkin seperti ini :
option explicit
public Sub Nyetak_hasil()
dim lCalc as long
dim i as long
with application
lcalc=.calculation
.calculation=xlCalculationManual
.enableevents=false
.screenupdating=false
end with
For i=1 to 100
'input data
'Cells(i+9,13).copy
'Range("F5").Select
'Selection.PasteSpecial Paste:=xlPasteValues
Range("F5").value=Cells(i+9,13).value
'biasanya perintah calculate akan meminta selesai sebelum mengerjakan baris lain
'selama tidak ada DoEvents
'jika hanya range tertentu yang harus dikalkulasi,
'range(ini dan itu).calculate
'saat ini pakai seluruh cell dalam sheet saja
activesheet.calculate
'paste output data
'Range("F46:F53").select '<== ini output data-nya
'Selection.copy
'Cells(i+9,47).select
'Selection.PasteSpecial Paste:=xlPasteValues, Transpose :=True
Range("F46:F53").copy
Cells(i+9,47).PasteSpecial Paste:=xlPasteValues, Transpose :=True
'if Cells(i+10,13)="" Then
if lenb( Cells(i+10,13).value ) < 1 then
exit for
end if
Next i
with application
.enableevents=true
.screenupdating=true
.calculation=lcalc
end with
end sub
Regards.
Kid.
Dear Kawans,
Mau tanya nih,,
Saya lagi bikin program sebagai berikut :
Sub Nyetak_hasil()
For i=1:100
'input data
Cells(i+9,13).copy
Range("F5").Select
Selection.PasteSpecial Paste:=xlPasteValues
'aku pengen macro break sebentar nyruput kopi dulu disini selama 20 detik
'disini excel-nya lagi kalkulasi (simulation dg program lain) otomatis karena perubahan input data di cell F5.. kalkulasinya makan waktu kira2 10-15 detik
'Nah sebelum kalkulasinya stop, macronya dilarang menyalip (ga boleh lanjut) karena output datanya belum matang.. masih digodok..
'Code-nya seperti apa ya disini???
'Kalo menggunakan application.wait kalkulasinya ikut berhenti juga... piye iki rek?
'paste output data
Range("F46:F53").select '<== ini output data-nya
Selection.copy
Cells(i+9,47).select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose :=True
if Cells(i+10,13)="" Then
exit for
end if
Next
end sub
Thanks,
VD
| silakan klik... ada buku nih.... dijamin bukan "bom buku"... |
| http://goo.gl/iQauc... btw kalau ada kerjaan enak kabarin momods |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/ |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html |
+-------------------------------------------------------------------+
| Message lama ada di : |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com |
+-------------------------------------------------------------------+
Nenhum comentário:
Postar um comentário