Sabtu, 28 Januari 2012

FUNGSI VBA EXCEL UNTUK KONVERSI TANGGAL


Berikut beberapa kode vba Excel untuk konversi tanggal Miladiyah ke Hijriyah , Jawi Islam ataupun sebaliknya.


Fungsi konversi tanggal miladiyah ke Julian Day

Function milaju(x, y, z)
Dim tahun, bul1, bul, tgl
Dim satu, tah, jjd, gjd, jul

If x = 0 Then MsgBox "Tidak ada Tahun Nol Gus "

If x < 0 Then
tahun = x + 1
Else
tahun = x
End If

bul1 = y
tgl = z
satu = Int((14 - bul1) / 12)
tah = tahun + 4800 - satu
bul = bul1 + 12 * satu - 3

jjd = tgl + Int((153 * bul + 2) / 5) + tah * 365 + Int(tah / 4) - 32083

gjd = tgl + Int((153 * bul + 2) / 5) + tah * 365 + Int(tah / 4) - Int(tah / 100) + Int(tah / 400) - 32045


If jjd > 2299159.5 Then
jul = gjd
Else
jul = jjd
End If

milaju = jul

End Function


Fungsi konversi tanggal Hijriyah urfi ke Julian Day


Function hijiju(x, y, z)
Dim tah, tahun, bul, tgl, hari

If x = 0 Then MsgBox "Tidak ada Tahun Nol Gus "

If x < 0 Then
tahun = x + 1
Else
tahun = x
End If

tah = tahun + 5498
bul = y
tgl = z
hari = Int((354 + 11 / 30) * tah - 353.85) + Int(29.5 * bul - 29) + tgl
hijiju = hari + 131

End Function


Fungsi konversi tanggal Jawi Islam ke Julian Day

Function jawijul(x, y, z)
Dim hari, jum, kor, t

If x >= 1627 And x <= 1674 Then
t = x + 5
hari = Int(t * 354.375 + 0.3) + Int(29.5 * y - 29) + z
kor = Int(t / 120)
jum = hari - kor + 1764877


Else
t = x + 53

hari = Int(t * 354.375 + 0.3) + Int(29.5 * y - 29) + z
kor = Int(t / 120)
jum = hari - kor + 1747867
End If

jawijul = jum


End Function


Fungsi konversi Julian Day ke tanggal Miladiyah

Function jumila(x)

Dim ctr0, ctr1, ctr2, ctr3, ctr4, ctr5, ctr6
Dim tanggal, bulan, tahun1, tahun, bln
Dim hari, pasaran, hr, ps

ctr0 = x
ctr1 = x + 32044
If ctr0 > 2299159.5 Then
ctr2 = Int((4 * ctr1 + 3) / 146097)
Else
ctr2 = 0
End If

If ctr0 > 2299159.5 Then
ctr3 = ctr1 - Int((ctr2 * 146097) / 4)
Else
ctr3 = ctr0 + 32082
End If

ctr4 = Int((4 * ctr3 + 3) / 1461)
ctr5 = ctr3 - Int((1461 * ctr4) / 4)
ctr6 = Int((5 * ctr5 + 2) / 153)

tanggal = ctr5 - Int((153 * ctr6 + 2) / 5) + 1
bulan = ctr6 + 3 - 12 * Int(ctr6 / 10)
tahun1 = ctr2 * 100 + ctr4 - 4800 + Int(ctr6 / 10)
If tahun1 < 1 Then
tahun = tahun1 - 1
Else
tahun = tahun1
End If

Select Case bulan
Case Is = 1
bln = "Januari"
Case Is = 2
bln = "Pebruari"
Case Is = 3
bln = "Maret"
Case Is = 4
bln = "April"
Case Is = 5
bln = "Mei"
Case Is = 6
bln = "Juni"
Case Is = 7
bln = "Juli"
Case Is = 8
bln = "Agustus"
Case Is = 9
bln = "September"
Case Is = 10
bln = "Oktober"
Case Is = 11
bln = "Nopember"
Case Is = 12
bln = "Desember"
End Select

hr = (ctr0 + 2) Mod 7

ps = (ctr0 + 1) Mod 5

Select Case hr
Case Is = 1
hari = "Ahad"
Case Is = 2
hari = "Senin"
Case Is = 3
hari = "Selasa"
Case Is = 4
hari = "Rabu"
Case Is = 5
hari = "Kamis"
Case Is = 6
hari = "Jum'at"
Case Is = 0
hari = "Sabtu"
End Select


Select Case ps
Case Is = 1
pasaran = "Legi"
Case Is = 2
pasaran = "Pahing"
Case Is = 3
pasaran = "Pon"
Case Is = 4
pasaran = "Wage"
Case Is = 0
pasaran = "Kliwon"
End Select


jumila = hari & " " & pasaran & " " & tanggal & " " & bln & " " & tahun

End Function



Fungsi konversi Julian Day ke tanggal Hijri Urfi

Function juhiji(x)
Dim tahun, sisa, s1, bulan, tanggal, bln, hr, ps, hari7, hari, pasaran

hari = x - 131

tahun = Int(hari * 3 / 1063.1) + 1
s1 = Int(tahun * 1063.1 / 3 - 353.85)
sisa = hari - s1

If sisa = 0 Then
tahun = Int(hari * 3 / 1063.1)
s1 = Int(tahun * 1063.1 / 3 - 353.85)
sisa = hari - s1

Else
tahun = tahun
sisa = sisa
End If
tahun = tahun
sisa = sisa

bulan = Int(sisa / 29.5 + 0.97)
If bulan > 12 Then bulan = 12

tanggal = sisa - Int(29.5 * bulan - 29)
tahun = tahun - 5498



If tahun < 1 Then
tahun = tahun - 1
Else
tahun = tahun
End If


Select Case bulan
Case Is = 1
bln = "Muharrom"
Case Is = 2
bln = "Shofar"
Case Is = 3
bln = "Robi'ul Awwal"
Case Is = 4
bln = "Robi'uts Tsani"
Case Is = 5
bln = "Jumadil Ula"
Case Is = 6
bln = "Jumadits Tsani"
Case Is = 7
bln = "Rojab"
Case Is = 8
bln = "Sya'ban"
Case Is = 9
bln = "Romadlon"
Case Is = 10
bln = "Syawwal"
Case Is = 11
bln = "Dzul Qo'dah"
Case Is = 12
bln = "Dzul Hijjah"
End Select

hr = (x + 2) Mod 7

ps = (x + 1) Mod 5

Select Case hr
Case Is = 1
hari7 = "Ahad"
Case Is = 2
hari7 = "Senin"
Case Is = 3
hari7 = "Selasa"
Case Is = 4
hari7 = "Rabu"
Case Is = 5
hari7 = "Kamis"
Case Is = 6
hari7 = "Jum'at"
Case Is = 0
hari7 = "Sabtu"
End Select


Select Case ps
Case Is = 1
pasaran = "Legi"
Case Is = 2
pasaran = "Pahing"
Case Is = 3
pasaran = "Pon"
Case Is = 4
pasaran = "Wage"
Case Is = 0
pasaran = "Kliwon"
End Select

juhiji = hari7 & " " & pasaran & " " & tanggal & " " & bln & " " & tahun

End Function


Fungsi konversi Julian Day ke tanggal Jawi Islam


Function juljawi(y)
Dim t, h, s, x, t1, h1, tahun, bulan, bln, tanggal
Dim sisa, hri, hari, hari7, ps, pasaran
Dim huruf, huruf1, huruf2, huruf3, huruf4, huruf5, huruf6

If y >= 2343204 And y <= 2360213 Then
x = y - 1747867
x = x - 7 * 2835

h = x + Int(x / 42524)
t = Int((354 + h) / 354.375) - 1

h1 = Int((t) * 354.375 + 0.3)

tahun = t + 3
sisa = h - h1
huruf2 = Int((tahun + 55) / 120) + 17

Else
x = y - 1747867
h = x + Int(x / 42524)
t = Int((354 + h) / 354.375) - 1

h1 = Int((t) * 354.375 + 0.3)

tahun = t - 53
sisa = h - h1
huruf2 = Int((tahun + 53) / 120) + 18

End If


If tahun < 1 Then
tahun = tahun - 1
Else
tahun = tahun
End If

bulan = Int(sisa / 29.5 + 0.97)
If bulan > 12 Then bulan = 12

tanggal = sisa - Int(29.5 * bulan - 29)




Select Case bulan
Case Is = 1
bln = "Sura"
Case Is = 2
bln = "Sapar"
Case Is = 3
bln = "Mulud"
Case Is = 4
bln = "Bakda Mulud"
Case Is = 5
bln = "Jumadilawal"
Case Is = 6
bln = "Jumadilakir"
Case Is = 7
bln = "Rejeb"
Case Is = 8
bln = "Ruwah"
Case Is = 9
bln = "Pasa"
Case Is = 10
bln = "Syawal"
Case Is = 11
bln = "Dulkangidah"
Case Is = 12
bln = "Besar"
End Select

hri = (x + 4) Mod 7

ps = (x + 3) Mod 5

Select Case hri
Case Is = 1
hari7 = "Ahad"
Case Is = 2
hari7 = "Senen"
Case Is = 3
hari7 = "Selasa"
Case Is = 4
hari7 = "Rebo"
Case Is = 5
hari7 = "Kemis"
Case Is = 6
hari7 = "Jumungah"
Case Is = 0
hari7 = "Setu"
End Select


Select Case ps
Case Is = 1
pasaran = "Legi"
Case Is = 2
pasaran = "Pahing"
Case Is = 3
pasaran = "Pon"
Case Is = 4
pasaran = "Wage"
Case Is = 0
pasaran = "Kliwon"
End Select

huruf = tahun Mod 8
Select Case huruf
Case Is = 1
huruf1 = "Wawu"
Case Is = 2
huruf1 = "Jim Akir"
Case Is = 3
huruf1 = "Alip"
Case Is = 4
huruf1 = "Ehe"
Case Is = 5
huruf1 = "Jim Awal"
Case Is = 6
huruf1 = "Ze"
Case Is = 7
huruf1 = "Dal"
Case Is = 0
huruf1 = "Be"
End Select

huruf3 = huruf2 Mod 7
huruf4 = huruf2 Mod 5

Select Case huruf3
Case Is = 1
huruf5 = "Angad"
Case Is = 2
huruf5 = "Atu"
Case Is = 3
huruf5 = "Angah"
Case Is = 4
huruf5 = "Amis"
Case Is = 5
huruf5 = "Abo"
Case Is = 6
huruf5 = "Asa"
Case Is = 0
huruf5 = "Anen"
End Select

Select Case huruf4
Case Is = 1
huruf6 = "gi"
Case Is = 2
huruf6 = "won"
Case Is = 3
huruf6 = "ge"
Case Is = 4
huruf6 = "pon"
Case Is = 0
huruf6 = "ing:"
End Select

juljawi = hari7 & " " & pasaran & " " & tanggal & " " & bln & " " & tahun & " " & huruf1 & " " & huruf5 & huruf6

End Function


Contoh file silakan download di :





Tidak ada komentar:

Posting Komentar