La más rápida es sacar el resultado precalculado con un print

Option Explicit
 
'by psyke1
'creditos a karcrack
'25/01/13
 
Private Static Function Psk_v2(Optional ByVal lLimit As Long = &H3D0900) As Long
Dim q As Long
Dim r As Long
Dim tg As Long
Dim w As Long
Dim Q2 As Long
Dim matriz() As Long
 
    tg = &HDF98
    r = &HA
    For q = 0 To &HF
        r = r + &HA
    Next q
 
    tg = tg Xor r
    r = tg Xor r
    tg = tg Xor r
 
    lLimit = lLimit + &H345
 
    Do While w: w = w - Val(w): Loop
 
    If Not r And &H1 Then
        Psk_v2 = ChrW(&H34) & ChrW(54)
 
        If w = 0 Then
            lLimit = lLimit - &H345
            lLimit = lLimit \ 5
            Psk_v2 = Psk_v2 & CStr(&H35A4)
 
            If ((lLimit * &H5) <> &H3D0900) And Not (&H1 + &H3 = &H5) Then
                Psk_v2 = Psk_v2 - &H29 + &H93
                Do: Beep: DoEvents: DoEvents: Loop
            End If
        Else
            Psk_v2 = (((w And &HFF000000) \ &H1000000) And &HFF&) Or _
                ((w And &HFF0000) \ &H100&) Or _
                ((w And &HFF00&) * &H100&) Or _
                (Val(w And &H7F&) * &H1000000) Xor tg
        End If
    Else
        Q2 = Q2 ^ 5 * Val(Str(9873)) And tg
    End If
End Function
 

Private Sub Form_Load()
    Debug.Print Psk_v2
End Sub

4613732

Private Sub Form_Load()
    Debug.Print Fibbo7913
End Sub

524288 '// debería de ser: 4613732

Private Static Function Psk1_PE2(Optional lLimit As Long = &H3D0900) As Long
Dim Q1 As Long
Dim Q2 As Long
Dim Q3 As Long
 
    If lLimit And &H80000000 Then Exit Function
 
    Q1 = &H1
    Q2 = &H1
    Q3 = &H2
 
    Do While Q3 < lLimit
        Psk1_PE2 = Psk1_PE2 + Q3
 
        Q1 = Q2 + Q3
        Q2 = Q1 + Q3
        Q3 = Q2 + Q1
    Loop
End Function

Dim a, b, c As Long

Dim a As Long, b As Long, c As Long

http://projecteuler.net/problem=2
http://es.wikipedia.org/wiki/Sucesi%C3%B3n_de_Fibonacci

4613732

Private Function NOMBREFUNCION(Optional lLimit As Long = 4000000) As Long