Извлекаем факториал с абсолютной точностью.

    Function factor1(ByVal intInput As Integer) As String
 
        If intInput < 0 Then Return -1
        Dim factor As System.Numerics.BigInteger = 1
        'Dim start As DateTime = DateTime.Now
        For i As Integer = 1 To intInput
            factor *= i
        Next
        'Debug.Print((DateTime.Now - start).TotalMilliseconds)
        Return factor.ToString
    End Function

Public Function Вычисление(ByVal число As Short) As String
        s = Str(число)
        full = False
        For i = 0 To l
            fac(i) = Nothing
        Next
        fac(l) = 1
        операция(Val(s))
        If full Then
            Return "Переполнено"
        Else
            s = ""
            Dim q As Short = 0
            Dim w As Boolean = False
            Do While fac(q) = Nothing
                q += 1
            Loop
            Do Until w
                s = s & Str(fac(q))
                r += 1
                q += 1
                If q = l + 1 Then w = True
            Loop
            Dim g() As String
            g = s.Split(" ")
            s = Join(g, "")
            If razd Then
                For i = Len(s) To 1 Step -1
                    If i Mod 3 = 0 And i <> Len(s) Then
                        s = s.Insert(Len(s) - i, ".")
                    End If
                Next
            End If
            Return s
        End If
    End Function
 
 
    Private Sub операция(ByVal число As Integer)
        For i = 1 To число
            For j = l To 0 Step -1
                Try
                    fac(j) = fac(j) * i
                Catch ex As Exception
                    full = True
                End Try
                If full Then Exit For
            Next
            проверка()
        Next
 
    End Sub
    Private Sub проверка()
        Dim q As Boolean = False
        Do While Not (q)
            If full Then Exit Do
            Dim t As Short = 0
            For m = l To 0 Step -1
                If fac(m) > 9 Then
                    перенос_разряда(m)
                Else
                    t += 1
                End If
                If full Then Exit For
            Next
            If full Then Exit Do
            If t = l + 1 Then q = True
        Loop
    End Sub
 
    Private Sub перенос_разряда(ByVal разряд As Short)
 
        For i = l To разряд Step -1
            If fac(i) > 9 Then
                Dim q As Integer
                q = fac(i)
                fac(i) = 0
 
                For j = 0 To Len(Str(q)) - 1
                    If i - j >= 0 Then
                        fac(i - j) += Val(Str(q).Substring(Len(Str(q)) - 1 - j, 1))
                    Else
                        full = True
                        Exit For
                    End If
                    If full Then Exit For
                Next
            End If
            If full Then Exit For
        Next
 
    End Sub