Institute of Inf. Tech. - Informatikai intézet

Definiáljunk egy teszt függvényt ami visszaad egy konstans értéket.

Function teszt()
   teszt = 1
End Function

használata: írjuk be egy cellába =teszt()

Adjunk össze két számot.

Function Osszeadas(szam1 As Double, szam2 As Double) As Double
    Osszeadas = szam1 + szam2
End Function

használata: =Osszeadas(A1;B1)

Ez a függvény egy tartomány elemeinek átlagát számítja ki.

Function TartomanyAtlag(tartomany As Range) As Double
    Dim osszeg As Double
    Dim db As Long
    
    osszeg = 0
    db = 0
    
    For Each cella In tartomany
        osszeg = osszeg + cella.Value
        db = db + 1
    Next cella
    
    TartomanyAtlag = osszeg / db
End Function

Töltsük fel tetszőleges értékekkel a A1 és B2 téglalapba eső cellákat:

Egy másik cellába írjukbe: =TartomanyAtlag(A1:B2)

Viszont, ha az értékek között van olyan ami nem szám, akkor nem működik, ezért alakítsuk át, hogy kezelje a kivételeket is.

Function TartomanyAtlag(tartomany As Range) As Double
    Dim cella As Range
    Dim osszeg As Double
    Dim db As Long
    
    osszeg = 0
    db = 0
    
    For Each cella In tartomany
        If IsNumeric(cella.Value) Then
            osszeg = osszeg + cella.Value
            db = db + 1
        End If
    Next cella
    
    If db > 0 Then
        TartomanyAtlag = osszeg / db
    Else
        TartomanyAtlag = 0
    End If
End Function

Töltsük fel tetszőleges értékekkel a A1 és B2 téglalapba eső cellákat, de az egyiket akarattal elrontjuk:

Egy másik cellába írjukbe: =TartomanyAtlag(A1:B2)

Szorozzunk össze egy mátrix-ot egy vektorral:

Function MatrixVektorSzorzas(matrix As Range, vektor As Range) As Variant
    Dim sorok As Long, oszlopok As Long, i As Long, j As Long
    Dim eredmeny() As Double
     
    sorok = matrix.Rows.Count
    oszlopok = matrix.Columns.Count
     
    ' Ellenőrizzük, hogy a vektor mérete megfelel-e a mátrix oszlopainak számával
    If vektor.Rows.Count <> oszlopok Or vektor.Columns.Count > 1 Then
        MatrixVektorSzorzas = CVErr(xlErrValue)
        Exit Function
    End If
     
    ' oszlopvektor legyen az eredmény
    ReDim eredmeny(1 To sorok, 1 To 1) As Double
     
    For i = 1 To sorok
        For j = 1 To oszlopok
            eredmeny(i, 1) = eredmeny(i, 1) + matrix.Cells(i, j).Value * vektor.Cells(j, 1).Value
        Next j
    Next i
     
    MatrixVektorSzorzas = eredmeny
End Function

Használata például ez lehet:

—