UDF ROMAN dan ARABIC

Excel memang sudah menyediakan fungsi bawaan seperti ROMAN untuk mengubah angka menjadi angka Romawi. Namun, bagi yang senang mengeksplorasi VBA dan membangun solusi sendiri, membuat fungsi Roman dan Arabic secara mandiri bisa menjadi latihan yang menarik.

Selain memberikan pemahaman lebih dalam tentang logika konversi angka, fungsi buatan sendiri juga memungkinkan kita menambahkan fitur, menyesuaikan aturan, atau mengoptimalkan perilaku fungsi sesuai kebutuhan.

Pada pembahasan ini, kita akan membuat dua User Defined Function (UDF), yaitu fungsi untuk mengubah angka Arab menjadi angka Romawi (UDF ROMAN) dan fungsi untuk mengubah angka Romawi kembali menjadi angka Arab (UDF ARABIC).

Dengan demikian, proses konversi dapat dilakukan dua arah langsung dari worksheet menggunakan rumus yang kita buat sendiri.

Mari kita mulai dari memahami cara kerja konversinya, lalu dilanjutkan dengan implementasi fungsi dan contoh penggunaannya di Excel.

Function ROMANKU(ByVal Angka As Long) As String
    Dim Nilai
    Dim Romawi
    Dim i As Long

    If Angka < 1 Or Angka > 3999 Then
        ROMANKU = CVErr(xlErrNum)
        Exit Function
    End If

    Nilai = Array(1000, 900, 500, 400, 100, 90, _
                  50, 40, 10, 9, 5, 4, 1)
    Romawi = Array("M", "CM", "D", "CD", "C", "XC", _
               "L", "XL", "X", "IX", "V", "IV", "I")

    For i = 0 To UBound(Nilai)
        Do While Angka >= Nilai(i)
            ROMANKU = ROMANKU & Romawi(i)
            Angka = Angka - Nilai(i)
        Loop
    Next i
End Function

Sedangkan untuk membalikannya mengubah romawi ke angka arabic, saya buatkan fungsi ARABICKU

Function ARABICKU(ByVal Romawi As String) As Long
    Dim i As Long
    Dim Curr As Long
    Dim NextVal As Long
    Dim Hasil As Long

    Romawi = UCase(Trim(Romawi))

    For i = 1 To Len(Romawi)
        Curr = Nilai(Mid(Romawi, i, 1))

        If Curr = 0 Then Exit Function

        If i < Len(Romawi) Then
            NextVal = Nilai(Mid(Romawi, i + 1, 1))
        Else
            NextVal = 0
        End If

        If Curr < NextVal Then
            Hasil = Hasil - Curr
        Else
            Hasil = Hasil + Curr
        End If
    Next i

    ARABICKU= Hasil
End Function

Function Nilai(ByVal Huruf As String) As Long
    Select Case UCase(Huruf)
        Case "I": Nilai = 1
        Case "V": Nilai = 5
        Case "X": Nilai = 10
        Case "L": Nilai = 50
        Case "C": Nilai = 100
        Case "D": Nilai = 500
        Case "M": Nilai = 1000
        Case Else: Nilai = 0
    End Select
End Function

Berikut hasil UDF dan Fungsi Excel yang saya coba berdampingan.

Leave a Reply

Your email address will not be published. Required fields are marked *

Chat WhatsApp
WhatsApp