Fungsi-Fungsi Matematika

Beikut ini contoh-contoh fungsi matematika, seperti: penjumlahan, perkalian, rata-rata, dsb. Deklarasikan fungsi-fungsi ini di sebuah class.

---

Option Explicit

Private i As Integer
Private mValue As Double

'Fungsi Penjumlahan
Function Sum(ParamArray Angka()) As Double
    mValue = 0
    For i = 0 To UBound(Angka)
        mValue = mValue + Angka(i)
    Next
    Sum = mValue
End Function

'Fungsi Rata-rata
Function Average(ParamArray Angka()) As Double
    mValue = 0
    For i = 0 To UBound(Angka)
        mValue = mValue + Angka(i)
    Next
    Average = mValue / i
End Function

'Funsi Perkalian
Function Multiply(ParamArray Angka()) As Double
    mValue = 1
    For i = 0 To UBound(Angka)
        mValue = mValue * Angka(i)
    Next
    Multiply = mValue
End Function

'Konversi Binear ke Desimal
Function BinearToDecimal(Nilai) As Long
    Dim intLen As Integer

    mValue = 0
    intLen = Len(CStr(Nilai))
    For i = 1 To intLen
        mValue = mValue + CLng(Mid(Nilai, i, 1)) * _
                (2 ^ (intLen - i))
    Next
    '
    BinearToDecimal = mValue
End Function

'Konversi Desimal ke Basis
Function Basis(IntAngka%, intBasis%) As String
    Dim intNilai&
    Dim intLen%
    Dim strHasil$, strHexa$, strEnd$, strSub$
    Do
        intNilai = IntAngka Mod intBasis
        IntAngka = IntAngka \ intBasis
        Select Case intNilai
            Case 10: strHexa = "A"
            Case 11: strHexa = "B"
            Case 12: strHexa = "C"
            Case 13: strHexa = "D"
            Case 14: strHexa = "E"
            Case 15: strHexa = "F"
            Case Else:
                strHexa = CStr(intNilai)
        End Select
         strHasil = strHasil + strHexa
    Loop Until IntAngka < intBasis

    intLen = Len(strHasil)
    strEnd = CStr(IntAngka)

    For i = intLen To 1 Step -1
        strSub = strSub + Mid(strHasil, i, 1)
    Next

    If (Mid(strEnd + strSub, 1, 1)) = "0" Then
        Basis = Mid(strEnd + strSub, _
          2, Len(strEnd + strSub) - 1)
    Else
        Basis = strEnd + strSub
    End If

End Function

'Konversi Desimal ke Romawi
Function Roman(IntAngka As Integer) As String
    Dim IntSeribu%, IntLimaRatus%
    Dim IntSeratus%, IntLimaPuluh%
    Dim IntSepuluh%, IntLima%, IntSatu%
    Dim StrSeribu$, StrLimaRatus$
    Dim StrSeratus$, StrLimaPuluh$
    Dim StrSepuluh$, StrLima$, StrSatu$
    Dim StrRomawi$

    IntSatu = IntAngka
    IntSeribu = IntAngka \ 1000
    IntSatu = IntAngka Mod 1000
    IntLimaRatus = IntSatu \ 500
    IntSatu = IntAngka Mod 500
    IntSeratus = IntSatu \ 100
    IntSatu = IntAngka Mod 100
    IntLimaPuluh = IntSatu \ 50
    IntSatu = IntAngka Mod 50
    IntSepuluh = IntSatu \ 10
    IntSatu = IntAngka Mod 10
    IntLima = IntSatu \ 5
    IntSatu = IntAngka Mod 5

    For i = 0 To IntSeribu - 1
        StrSeribu = StrSeribu + "M"
    Next

    If IntSeratus <> 4 Then
        For i = 0 To IntLimaRatus - 1
            StrLimaRatus = StrLimaRatus + "D"
        Next
    End If

    For i = 0 To IntSeratus - 1
        StrSeratus = StrSeratus + "C"
    Next

        If IntSeratus = 4 Then
            If IntLimaRatus = 1 Then
                StrSeratus = StrRomawi + "CM"
            Else
                StrSeratus = StrRomawi + "CD"
            End If
        End If

    If IntSepuluh <> 4 Then
        For i = 0 To IntLimaPuluh - 1
            StrLimaPuluh = StrLimaPuluh + "L"
        Next
    End If

    For i = 0 To IntSepuluh - 1
        StrSepuluh = StrSepuluh + "X"
    Next

        If IntSepuluh = 4 Then
            If IntLimaPuluh = 1 Then
                StrSepuluh = StrRomawi + "XC"
            Else
                StrSepuluh = StrRomawi + "XL"
            End If
        End If

        If IntSatu <> 4 Then
            For i = 0 To IntLima - 1
                StrLima = StrLima + "V"
            Next
        End If

        For i = 0 To IntSatu - 1
            StrSatu = StrSatu + "I"
        Next

        If IntSatu = 4 Then
            If IntLima = 1 Then
                StrSatu = StrRomawi + "IX"
            Else
                StrSatu = StrRomawi + "IV"
            End If
        End If

    StrRomawi = StrSeribu + StrLimaRatus _
                + StrSeratus + StrLimaPuluh _
                + StrSepuluh + StrLima + StrSatu
    Roman = StrRomawi
End Function

'Fungsi mencari nilai maksimum dengan
'menggunakan parameter input berupa array

Function NilaiMax1(ParamArray Nilai()) As Double
    Dim i As Long
    Dim nMax As Double
    Dim nTemp As Double

    For i = LBound(Nilai) To UBound(Nilai)
        nMax = Nilai(i)
        If nTemp > nMax Then
            nMax = nTemp
        End If
        nTemp = nMax
    Next
    NilaiMax1 = nMax
End Function

'Fungsi mencari nilai maksimum dengan
'menggunakan parameter input berupa daftar deret

Function NilaiMax2(DeretAngka$) As Double
    Dim i As Long
    Dim nMax As Double
    Dim nTemp As Double

    Dim Pisah() As String
    Pisah = Split(DeretAngka$, ";")

    For i = LBound(Pisah) To UBound(Pisah)
        nMax = Val(Pisah(i))
        If nTemp > nMax Then
            nMax = nTemp
        End If
        nTemp = nMax
    Next
    NilaiMax2 = nMax
End Function

'Fungsi mencari nilai minimum dengan
'menggunakan parameter input berupa array

Function NilaiMin1(ParamArray Nilai()) As Double
    Dim i As Long
    Dim nMin As Double
    Dim nTemp As Double

    nTemp = 1

    For i = LBound(Nilai) To UBound(Nilai)
        nMin = Nilai(i)
        If nTemp < nMin Then
            nMin = nTemp
        End If
        nTemp = nMin
    Next
    NilaiMin1 = nMin
End Function

'Fungsi mencari nilai minimum dengan
'menggunakan parameter input berupa daftar deret

Function NilaiMin2(DeretAngka$) As Double
    Dim i As Long
    Dim nMin As Double
    Dim nTemp As Double

    Dim Pisah() As String
    Pisah = Split(DeretAngka$, ";")

    nTemp = 1

    For i = LBound(Pisah) To UBound(Pisah)
        nMin = Val(Pisah(i))
        If nTemp < nMin Then
            nMin = nTemp
        End If
        nTemp = nMin
    Next
    NilaiMin2 = nMin
End Function

Private Sub Class_Initialize()
    mValue = 0
End Sub

---

Namai class degan “cMath”. Untuk bahan pengujian, ketik kode di bawah ini

---

Dim myMath As New cMath

Private Sub Form_Load()
    Set myMath = New cMath

    MsgBox myMath.Average(7, 8, 3, 2, 7, 5, 8, 4, 2, 3)
    MsgBox myMath.Sum(7, 8, 3, 2, 7, 5, 8, 4, 2, 3)
    MsgBox myMath.Multiply(5, 8, 4, 2, 3)
    MsgBox myMath.BinearToDecimal("1001010011100")
    MsgBox myMath.Roman(2008)

End Sub