INOCHI-GAPTEK
Would you like to react to this message? Create an account in a few clicks or log in to continue.

Fungsi-Fungsi Matematika

3 posters

Go down

Fungsi-Fungsi Matematika Empty Fungsi-Fungsi Matematika

Post by PujanggaBageur Fri Aug 15, 2008 4:36 pm

Deklarasikan di module Class!

Code:

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
PujanggaBageur
PujanggaBageur
Admin
Admin

Jumlah posting : 148
Join date : 07.08.08
Age : 41
Lokasi : Cirebon

https://inochi.indonesianforum.net

Kembali Ke Atas Go down

Fungsi-Fungsi Matematika Empty Re: Fungsi-Fungsi Matematika

Post by flack Mon Oct 27, 2008 11:28 am

Keren...
flack
flack
Lahir
Lahir

Jumlah posting : 5
Join date : 27.10.08
Age : 34
Lokasi : Sidoarjo

Kembali Ke Atas Go down

Fungsi-Fungsi Matematika Empty Re: Fungsi-Fungsi Matematika

Post by agoes_doubleb Mon Oct 27, 2008 9:49 pm

flack wrote:Keren...

Siapa nih???? jangan2 Kloningnya yang di Forum sebelah...
agoes_doubleb
agoes_doubleb
Moderator
Moderator

Jumlah posting : 25
Join date : 01.09.08
Age : 33
Lokasi : Denpasar

http://www.menara-fm.com

Kembali Ke Atas Go down

Fungsi-Fungsi Matematika Empty Re: Fungsi-Fungsi Matematika

Post by PujanggaBageur Mon Oct 27, 2008 10:13 pm

Sebelum ada yang minta, saya kasih tau duluan ya....
"Untuk saat ini forum sudah menutup pendaftaran sebagai moderator" Evil or Very Mad
PujanggaBageur
PujanggaBageur
Admin
Admin

Jumlah posting : 148
Join date : 07.08.08
Age : 41
Lokasi : Cirebon

https://inochi.indonesianforum.net

Kembali Ke Atas Go down

Fungsi-Fungsi Matematika Empty Re: Fungsi-Fungsi Matematika

Post by flack Tue Oct 28, 2008 8:34 am

moderator itu apa ya om.. ?
flack
flack
Lahir
Lahir

Jumlah posting : 5
Join date : 27.10.08
Age : 34
Lokasi : Sidoarjo

Kembali Ke Atas Go down

Fungsi-Fungsi Matematika Empty Re: Fungsi-Fungsi Matematika

Post by agoes_doubleb Tue Oct 28, 2008 9:14 am

Moderator???? Shocked Shocked
agoes_doubleb
agoes_doubleb
Moderator
Moderator

Jumlah posting : 25
Join date : 01.09.08
Age : 33
Lokasi : Denpasar

http://www.menara-fm.com

Kembali Ke Atas Go down

Fungsi-Fungsi Matematika Empty Re: Fungsi-Fungsi Matematika

Post by Sponsored content


Sponsored content


Kembali Ke Atas Go down

Kembali Ke Atas

- Similar topics

 
Permissions in this forum:
Anda tidak dapat menjawab topik