Dear HerrSoe, Ysh: Moderators & para member milis XL-mania,
Listing code berikut adalah listing versi beta. Seingat saya, ada sedikit perubahan supaya lebih tepat (alias versi ini masih ada sedikit error hasil perhitungan)
Nah fungsi ini digunakan layaknya fungsi-fungsi pada formula biasanya.
Cukup letakkan pada sebuah module VBA.
Cara pakai :
Misal di Cell A2 adalah tanggal awal
B2 adalah jumlah hari kerja kedepan (+) atau kebelakang (-)
Z1 sampai Z25 adalah daftar tanggal libur nasional, dan libur yang ditetapkan perusahaan.
Libur rutin untuk pegawai di baris 2 ini adalah Minggu (hari ke 1), Rabu (hari ke 4), dan Jumat (hari ke 6),
maka di C2 ada teks 1,4,6
Maka hasil di D2 :
=FirstWorkday(
'Kid - 12-06-1999
Public Function FirstWorkday(
Optional dblDays As Double = 0, _
Optional vHolidays As Variant = 0, _
Optional sRutin As String = vbNullString) As Variant
Dim lStart As Long
Dim lDays As Long
Dim lFact As Long
Dim vHol As Variant
Dim vTmp As Variant
Dim sCust() As String
Dim lCust() As Long
Dim bCust As Boolean
Dim lRes As Long
Dim lTmp As Long
Dim bHol As Boolean
On Error GoTo ErrResult
lStart = CLng(WorksheetFunct
If dblDays < 0 Then
lFact = -1
lDays = CLng(WorksheetFunct
Else
lFact = 1
lDays = CLng(WorksheetFunct
End If
vHol = vHolidays
If IsArray(vHol) Then
vTmp = vHol
Else
ReDim vTmp(1 To 1, 1 To 1)
vTmp(1, 1) = vHol
End If
bCust = False
If LenB(sRutin) <> 0 Then
sCust() = Split(sRutin, ",")
lTmp = UBound(sCust)
If lTmp > 5 Then 'start dari 0, maka 5 = hari ke enam
'karena jika libur rutin lebih dari 6 hari = libur terus
GoTo ErrResult
End If
ReDim lCust(lTmp)
For lRes = 0 To lTmp
If IsNumeric(sCust(
bCust = True
lCust(lRes) = CLng(sCust(lRes)
Else
bCust = False
Exit For
End If
Next
If Not bCust Then
GoTo ErrResult
End If
Else
ReDim lCust(1)
lCust(0) = 1
lCust(1) = 7
End If
lRes = lStart
lTmp = 0
Do
bHol = False
'cek di daftar libur khusus
For Each vHol In vTmp
If lStart = vHol Then
bHol = True
'lDays = lDays + 1
Exit For
End If
Next
'cek didaftar libur rutin
If Not bHol Then
For Each vHol In lCust
If Weekday(CDate(
bHol = True
Exit For
End If
Next
End If
'set result as new workday
If Not bHol Then
lRes = lStart
lTmp = lTmp + 1
End If
lStart = lStart + lFact
Loop Until lTmp > lDays
If lRes < 61 Then
GoTo ErrResult
ElseIf lRes > 2958465 Then
GoTo ErrResult
Else
FirstWorkday = lRes
End If
Exit Function
ErrResult:
FirstWorkday = CVErr(xlErrNum) '"#ERR := #NUM!"
End Function
Semoga bermanfaat.
Kid.
Terima kasih, dari milis ini saya mendapat pelajaran berharga: bahwa excel dapat menghitung
JUMLAH HARI KERJA dari tglMULAI s/d tglAKHIR dimana hari Sabtu dan Minggu = bukan hari kerja
(diabaikan) dan Hari Libur (yg kita buat List-nya) juga tidak ikut diperhitungkan.
Dlm Kasus spt itu dipergunakan Fungsi NETWORKDAYS.
"Bukan-Hari-Kerja" pada fungsi NetWorkDays sudah tertentu: Sabtu+Minggu.
Dlm palajaran itu juga dicontohkan FORMULA yg menyamai prinsip kerja NETWORKDAYS
tetapi malah lebih lengkap, yaitu "Bukan-Hari-Kerja"-nya dapat diubah sesuai kehendak / keperluan kita.
( ref milis 17sep 09: http://tech.
Saat ini kami menghadapi keperluan kalkulasi: kebalikan dari NETWORKDAYS, yaitu menentukan
Tanggal HariKerja Terakhir bila diketahui Tanggal Awal dan JUMLAH HARI KERJA yg diperlukan.
Sedangkan Hari Libur di kantor kami ada 2 aturan:
1. Karyawan level tertentu (X) Hari Kerja = Senin -sd- Jumat
(untuk kasus satu kami sudah menemukan fungsinya : Workday)
2. Karyawan level tertentu (Y) Hari Kerja = Senin -sd- Sabtu
3. Bahkan nantinya direncanakan ada karyawan level tertentu (Z) yg harikerjanya = Senin -sd- Kamis
Untuk kasus 2 dan 3 selama ini kami masih menghitungnya secara manual di lembar Kalender.
Mohon bantuan dari para XL-maniawan / XL-maniawati ysh, kiranya dapat memberi formulasi
serta jika mungkin penjelasannya. (terlampir workbook berisi kasus tsb serta tambahan ).
Sekali lagi terima kasih.
herrsoe
(herru sucakil... :)
| Selamat Idul Fitri... Mohon maap dari 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 |
+-------------------------------------------------------------------+
Change settings via the Web (Yahoo! ID required)
Change settings via email: Switch delivery to Daily Digest | Switch format to Traditional
Visit Your Group | Yahoo! Groups Terms of Use | Unsubscribe
Nenhum comentário:
Postar um comentário