How do you want it to be generated? What do you expect it to look like?
- Ask the user to enter a number.
- Generate the Fibonacci sequence from 0 to that number.
How do you want it to be generated? What do you expect it to look like?
Try this on a blank sheet. It will generate the sequence in column B.
Code:Sub fib() Dim x As Long x = InputBox("Enter a number.") Range("B1") = 0 Range("B2") = 1 Do If Range("B" & Range("B" & Rows.Count).End(xlUp).Row).Value + _ Range("B" & Range("B" & Rows.Count).End(xlUp).Row).Offset(-1, 0).Value >= x _ Then Exit Sub Range("B" & Range("B" & Rows.Count).End(xlUp).Row).Offset(1, 0).FormulaR1C1 = _ "=R[-1]C+R[-2]C" Loop End Sub
Last edited by bbott; Oct 8th, 2014 at 04:20 PM. Reason: Adjusted code.
Using Excel 2013
"Short answer yes with an if, long answer no with a but."
-Reverend Lovejoy, The Simpsons
Here is a function that will return the nth fib number.
Here is vba that will return it comma delimeted in A1.Code:Function Fib(n As Long) As Long Dim first As Long Dim second As Long Dim sum As Long Dim i As Long first = 0 second = 1 sum = 0 If n = 0 Then Fib = first ElseIf n = 1 Then Fib = second Else For i = 2 To n sum = first + second first = second second = sum Next i Fib = sum End If End Function
Code:Sub fibinach() Dim i As Integer Dim x As Integer Dim y As Integer Dim z As Integer Dim answer As String Dim Number As Long Number = InputBox("Enter a number") x = 0 y = 0 z = 1 For i = 1 To 10 answer = answer & z & ", " x = y y = z z = x + y If z > Number Then answer = Left(answer, Len(answer) - 2) Cells(1, 1) = answer Exit Sub End If Next End Sub
Below is an "infinite" precision function that I developed and posted back in 2002 to a VB newsgroup which prints the Nth Fibonacci number to as many digits as a string can hold. (Be aware, this routine slows down as the inputted number gets larger)...
Code:Function FN(ByVal N As Integer) As String Dim X As Long, Z As Long, Carry As Long, PositionSum As Long Dim N_minus_0 As String, N_minus_1 As String, N_minus_2 As String If N = 1 Or N = 2 Then FN = 1 Else N_minus_1 = "1" N_minus_2 = "1" For X = 3 To N Carry = 0 N_minus_0 = Space$(Len(N_minus_1)) If Len(N_minus_1) > Len(N_minus_2) Then N_minus_2 = "0" & N_minus_2 For Z = Len(N_minus_1) To 1 Step -1 PositionSum = Val(Mid$(N_minus_1, Z, 1)) + Val(Mid$(N_minus_2, Z, 1)) + Carry Mid$(N_minus_0, Z, 1) = Right$(CStr(PositionSum), 1) Carry = IIf(PositionSum < 10, 0, 1) Next If Carry Then N_minus_0 = "1" & N_minus_0 N_minus_2 = N_minus_1 N_minus_1 = N_minus_0 Next FN = N_minus_0 End If End Function
Rick's "mini" blog... http://www.excelfox.com/forum/f22/
.
Want to post a small screen shot? See Part B here.
As I said earlier, this was old code... I changed some variables that were declared as Integers to Long, but I see I missed changing the argument to the function... that should be changed to Long as well.
I also forgot to mention that the function can be used as a UDF (user defined function) in a worksheet formula as well as being able to be called from other VB code). I guess I should note, because of the size of the numbers that can be returned by the function, the function outputs a text string value, not a real number.Code:Function FN(ByVal N As Long) As String Dim X As Long, Z As Long, Carry As Long, PositionSum As Long Dim N_minus_0 As String, N_minus_1 As String, N_minus_2 As String If N = 1 Or N = 2 Then FN = 1 Else N_minus_1 = "1" N_minus_2 = "1" For X = 3 To N Carry = 0 N_minus_0 = Space$(Len(N_minus_1)) If Len(N_minus_1) > Len(N_minus_2) Then N_minus_2 = "0" & N_minus_2 For Z = Len(N_minus_1) To 1 Step -1 PositionSum = Val(Mid$(N_minus_1, Z, 1)) + Val(Mid$(N_minus_2, Z, 1)) + Carry Mid$(N_minus_0, Z, 1) = Right$(CStr(PositionSum), 1) Carry = IIf(PositionSum < 10, 0, 1) Next If Carry Then N_minus_0 = "1" & N_minus_0 N_minus_2 = N_minus_1 N_minus_1 = N_minus_0 Next FN = N_minus_0 End If End Function
Rick's "mini" blog... http://www.excelfox.com/forum/f22/
.
Want to post a small screen shot? See Part B here.
I just re-read the original message and see that the OP was not looking for a function like I posted in Message #6, so here is that code recast to a subroutine that asks the user to input the value whose Fibonacci number he/she wants to calculate. Just to reiterate, though, the function slows down quite a bit as the Fibonacci number being calculated increases; for example, I have a fairly fast computer and it took 7.8 seconds for it to calculate the 2090 digits for the number 9999; so, consider this note a word to the wise.
Code:Sub Fibonacci() Dim X As Long, Z As Long, N As Long, Carry As Long, PositionSum As Long Dim N_minus_0 As String, N_minus_1 As String, N_minus_2 As String N = Format(Application.InputBox("Please enter which Fibonacci Number you want to calculate...", Type:=1), "0") If N = 1 Or N = 2 Then MsgBox 1 ElseIf N > 2 Then N_minus_1 = "1" N_minus_2 = "1" For X = 3 To N Carry = 0 N_minus_0 = Space$(Len(N_minus_1)) If Len(N_minus_1) > Len(N_minus_2) Then N_minus_2 = "0" & N_minus_2 For Z = Len(N_minus_1) To 1 Step -1 PositionSum = Val(Mid$(N_minus_1, Z, 1)) + Val(Mid$(N_minus_2, Z, 1)) + Carry Mid$(N_minus_0, Z, 1) = Right$(CStr(PositionSum), 1) Carry = IIf(PositionSum < 10, 0, 1) Next If Carry Then N_minus_0 = "1" & N_minus_0 N_minus_2 = N_minus_1 N_minus_1 = N_minus_0 Next MsgBox N_minus_0 Else MsgBox "The number you enter must be greater than zero!" End If End Sub
Rick's "mini" blog... http://www.excelfox.com/forum/f22/
.
Want to post a small screen shot? See Part B here.
Code:Function Fib(n As Long) As Variant Dim first As Long Dim second As Long Dim sum As Long Dim i As Long first = 0 second = 1 sum = 0 If n = 0 Then Fib = first ElseIf n = 1 Then Fib = second Else For i = 2 To n sum = first + second first = second second = sum Fib = Fib & "," & sum Next i Fib = Right(Fib, Len(Fib) - 1) End If End Function
For those who might be interested, it took my code 12.6 minutes to calculate the 20,899 digits for the Fibonacci Number 99999 on my relatively fast computer. I will note, by the way, for comparison purposes, that NeonRedSharpie's code seems to be limited to calculating a maximum Fibonacci Number of 46.
Rick's "mini" blog... http://www.excelfox.com/forum/f22/
.
Want to post a small screen shot? See Part B here.
Like this thread? Share it with others