Calcular factorial

[mantekilla]

Amigos me piden este trabajo

Crear un formulario del cual:

1.- Ingresar el valor del factorial que desee calcular en una celda.

2.- Que arroje el resultado en la celda contigua.

3.- Un diseño atractivo

4.- Con un botón que traiga dicho formulario

5.- Que oculte dicho formulario después de realizar la tarea.

6.- El calcule debe realizarlo con las instrucciones GOTO, IF THEN , etc.

Al parecer no es tan sencillo o sera que los archivos que vi en el foro son tan impresionantes

que me asuste de frenton

hay unos archivo de NEVER y del maestro Mjrofra

pero no supe como poder adaptarlo a mis necesidades si alguien del foro

me pudiera ayudar lo agradecería un monton.

[mantekilla]

este es un codigo del master neverdellimon por si sirve para que me ayuden

Option Explicit

Function MYFactorial(ByRef Num As Long)

Dim f As String, j As Integer

If Num < 0 Then

If Num = 0 Then MYFactorial = 1 Else MYFactorial = "ERROR"

Else

If Num <= 26 Then

'Maximo factorial en notación decimal

MYFactorial = CStr(VBA.CDec(Application.WorksheetFunction.Fact(Num)))

Else

'recopilamos el mayor decimal que puede leer VBA

f = CStr(VBA.CDec(Application.WorksheetFunction.Fact(26)))

For j = 27 To Num

f = Multiplica_Catidades_Semimanual(f, j)

Next j

MYFactorial = f

End If

End If

End Function

Private Function Multiplica_SemiManual(ByRef valor As String, ByRef n As Byte) As String

'obtiene la multiplicación de una cadena por un solo número

'[n] debe de estar entre 0 y 9

Dim Acum As Long, i As Long, Res As String, ResTemp As String

For i = VBA.Len(valor) To 1 Step -1

ResTemp = VBA.Mid(valor, i, 1) * n

ResTemp = VBA.Val(ResTemp) + VBA.Val(Acum)

Acum = 0

If ResTemp <= 9 Then

Res = ResTemp & Res

Else

Res = VBA.Right(ResTemp, 1) & Res

Acum = VBA.Left(ResTemp, VBA.Len(ResTemp) - 1)

End If

Next i

If Acum > 0 Then Res = Acum & Res

Multiplica_SemiManual = Res

End Function

Private Function Multiplica_Catidades_Semimanual(ByVal Num1 As String, ByVal Num2 As String)

Dim MtzRes() As String, i As Long, j As Long, MaximoL As Long, Acum As Long, ResTemp As String, Res As String

For i = VBA.Len(Num2) To 1 Step -1

j = j + 1

ReDim Preserve MtzRes(1 To j)

MtzRes(j) = Multiplica_SemiManual(Num1, VBA.Mid(Num2, i, 1))

Next i

'completamos ceros a la izquierda

For i = 1 To j

MtzRes(i) = MtzRes(i) & Application.WorksheetFunction.Rept("0", i - 1)

Next i

'se determina la cadena mas grande

For i = 1 To j

If VBA.Len(MtzRes(i)) > MaximoL Then MaximoL = VBA.Len(MtzRes(i))

Next i

'se completan las cadenas de lado izquierdo para tenerlas del mismo tamaño

For i = 1 To j

If VBA.Len(MtzRes(i)) < MaximoL Then MtzRes(i) = Application.WorksheetFunction.Rept("0", MaximoL - VBA.Len(MtzRes(i))) & MtzRes(i)

Next i

'se realiza la suma de la matriz en forma vertical

For i = MaximoL To 1 Step -1

ResTemp = 0

For j = LBound(MtzRes) To UBound(MtzRes)

ResTemp = VBA.Mid(MtzRes(j), i, 1) + VBA.Val(ResTemp)

Next j

ResTemp = VBA.Val(ResTemp) + VBA.Val(Acum)

Acum = 0

If ResTemp <= 9 Then

Res = ResTemp & Res

Else

Res = VBA.Right(ResTemp, 1) & Res

Acum = VBA.Left(ResTemp, VBA.Len(ResTemp) - 1)

End If

Next i

If Acum > 0 Then Res = Acum & Res

Multiplica_Catidades_Semimanual = Res

End Function

[neverdelimon1]

Hola, puedes comenzar con algo sencillo como una función recursiva (es decir que se llama a si misma) por ejemplo:

Function CalculaFactorial(Numero As Long) As Double

    If Numero = 0 Then CalculaFactorial = 1 Else CalculaFactorial = Numero * CalculaFactorial(Numero - 1)

End Function[/CODE]

el anterior código lo pegas en un modulo estándar y la función la puedes llamar des la hoja de Excel

saludos