经典问题vba代码示例
题目基本来自c经典编程,用vba全部重新写了,可以作为代码的参考 ‘【程序1】
‘题目:古典问题:有一对兔子,从出生后第3个月起每个月都生一对兔子,小兔子长到第三个月
‘后每个月又生一对兔子,假如兔子都不死,问每个月的兔子总对数为多少?
‘1.程序分析:兔子的规律为数列1,1,2,3,5,8,13,21....
‘2.程序代码
Sub prog1()
‘
Dim tuji, f(20)
n = 20
For i = 1 To 20
If i = 1 Then f(i) = 1
If i = 2 Then f(i) = 1
If i > 2 Then
f(i) = f(i - 1) + f(i - 2)
End If
Next
MsgBox CStr(f(20))
End Sub
‘ 【程序2】
‘题目:一个整数,它加上100后是一个完全平方数,再加上168又是一个完全平方数,请问该数是多少?
Sub prog2()
‘
Dim jilu(100), strjilu
j = 1
For i = 1 To 100
jilu(i) = 0
Next i
For i = 1 To 10000
If Sqr(i + 100) = Int(Sqr(i + 100)) Then
If Sqr(i + 268) = Int(Sqr(i + 268)) Then
jilu(j) = i
j = j + 1
‘MsgBox "该数为" & CStr(i)
‘Exit For
End If
End If
Next
If jilu(1) = 0 Then
MsgBox "meiyou"
Else
For i = 1 To 100
If jilu(i) <> 0 Then
strjilu = strjilu + "||" + CStr(jilu(i))
End If
Next
MsgBox "该数为" & strjilu
End If
End Sub
【程序3】
‘题目:输入两个正整数m和n,求其最大公约数和最小公倍数。 Sub prog3() ‘ Dim m, n m = 30: n = 14 If m = n Then beishu = m yueshu = m ElseIf m > n Then For i = n To 1 Step -1 If (m Mod i = 0) And (n Mod i = 0) Then yueshu = i Exit For End If Next j = m tt = 0 Do While (tt = 0) j = j + 1 If (j Mod m = 0) And (j Mod n = 0) Then beishu = j tt = 1 End If Loop End If MsgBox "beishu" & CStr(beishu) & " " & "yueshu" & CStr(yueshu) End Sub ‘【程序4】 ‘题目:一个数如果恰好等于它的因子之和,这个数就称为“完数”。例如6=1+2+3.编程找出100以内的所有完数? ‘对n进行分解质因数,应先找到一个最小的质数k,然后按下述步骤完成: ‘(1)如果这个质数恰等于n,则说明分解质因数的过程已经结束,打印出即可。 ‘(2)如果n<>k,但n能被k整除,则应打印出k的值,并用n除以k的商,作为新的正整数n,重复执行第一步 ‘(3)如果n不能被k整除,则用k+1作为k的值,重复执行第一步。 Sub prog4() ‘ Dim a(20) n = 1 m = 1 For i = 1 To 100 ‘ k = 1 a(1) = 1 For j = 2 To 20 a(j) = 0 Next l = i pp = True ‘寻找数的因子 Do While pp If l = 1 Then Exit Do End If For j = 2 To l If l Mod j = 0 Then a(k) = j k = k + 1 l = l / j Exit For End If Next Loop ‘求各因子的和 s = 0 For j = 1 To 20 s = s + a(j) Next ‘判断是否相等 If (s + 1) = i Then Sheet2.Cells(n, 3) = i n = n + 1 ‘Exit For End If ‘ For j = 1 To 20 If a(j) <> 0 Then Sheet2.Cells(m, 4) = 1 Sheet2.Cells(m, j + 4) = a(j) Else Exit For End If Next m = m + 1 Next End Sub 【程序5】
‘题目:一球从100米高度自由落下,每次落地后反跳回原高度的一半;再落下,求它在第10次落地时,共经过多少米?第10次反弹多高? Sub prog5() ‘ Dim fantai(10) fantai(1) = 100 For i = 2 To 10 fantai(i) = fantai(i - 1) / 2 Next s = 0 For i = 1 To 10 s = s + fantai(i) Next MsgBox "共经过" & CStr(s) & "米;第10次反弹" & CStr(fantai(10)) End Sub ‘【程序6】 ‘题目:猴子吃桃问题:猴子第一天摘下若干个桃子,当即吃了一半,还不过瘾,又多吃了一个第二天早上又将剩下的桃子吃掉一半, ‘又多吃了一个。以后每天早上都吃了前一天剩下的一半零一个。到第10天早上想再吃时,见只剩下一个桃子了。求第一天共摘了多少。 Sub prog6() ‘ Dim taozi(10) For i = 10 To 1 Step -1 If i = 10 Then taozi(i) = 1 Else taozi(i) = (taozi(i + 1) + 1) * 2 End If Next MsgBox CStr(taozi(1)) End Sub 【程序7】
‘题目:编写一个函数,输入n为偶数时,调用函数求1/2+1/4+...+1/n,当输入n为奇数时,调用函数 ‘1/1+1/3+...+1/n(利用指针函数) Sub prog7() ‘ n = 12 s = 0 If n Mod 2 = 0 Then For i = 2 To n Step 2 s = s + 1 / i Next Else For i = 1 To n Step 2 s = s + 1 / i Next End If MsgBox CStr(s) End Sub
‘【程序8】
‘题目:海滩上有一堆桃子,五只猴子来分。第一只猴子把这堆桃子凭据分为五份,多了一个,这只 ‘猴子把多的一个扔入海中,拿走了一份。第二只猴子把剩下的桃子又平均分成五份,又多了 ‘一个,它同样把多的一个扔入海中,拿走了一份,第三、第四、第五只猴子都是这样做的, ‘问海滩上原来最少有多少个桃子? Sub prog8() ‘ j = 1 For i = 1 To 10000 If (i - 1) Mod 5 = 0 Then ‘1只猴子分 t1 = (i - 1) * 4 / 5 If (t1 - 1) Mod 5 = 0 Then ‘2只猴子分 t2 = (t1 - 1) * 4 / 5 If (t2 - 1) Mod 5 = 0 Then ‘3只猴子分 t3 = (t2 - 1) * 4 / 5 If (t3 - 1) Mod 5 = 0 Then ‘4只猴子分 t4 = (t3 - 1) * 4 / 5 If (t4 - 1) Mod 5 = 0 Then ‘5只猴子分 Sheet1.Cells(j, 1) = i Sheet1.Cells(j, 2) = t1 / 4 Sheet1.Cells(j, 3) = t2 / 4 Sheet1.Cells(j, 4) = t3 / 4 Sheet1.Cells(j, 5) = t4 / 4 Sheet1.Cells(j, 6) = (t4 - 1) / 5 j = j + 1 ‘If j = 21 Then Exit For ‘MsgBox "taozhi" & CStr(i) ‘Exit For End If End If End If End If End If Next End Sub 【程序9】
‘题目:打印出所有的“水仙花数”,所谓“水仙花数”是指一个三位数,其各位数字立方和等于该数 ‘本身。例如:153是一个“水仙花数”,因为153=1的三次方+5的三次方+3的三次方。 Sub prog9() ‘ m = 1 For i = 100 To 999 j = Int(i / 100) k = Int((i - j * 100) / 10) l = i - 100 * j - k * 10 If i = j ^ 3 + k ^ 3 + l ^ 3 Then Sheet1.Cells(m, 8) = i m = m + 1 End If Next End Sub ‘【程序10】 ‘题目:求1+2!+3!+...+20!的和 Sub prog10() ‘ s = 0 For i = 1 To 20 t = 1 For j = 1 To i t = t * j Next s = s + t Next MsgBox CStr(s) End Sub 【程序11】
‘题目:一个5位数,判断它是不是回文数。即12321是回文数,个位与万位相同,十位与千位相同。 Sub prog11() ‘ j = 1 For i = 10000 To 99999 k = Int(i / 10000) l = Int((i - k * 10000) / 1000) m = CInt(Left((Right(CStr(i), 2)), 1)) n = CInt((Right(CStr(i), 1))) If (k = n) And (l = m) Then Sheet2.Cells(j, 1) = i j = j + 1 End If Next End Sub ‘【程序12】 ‘题目:判断101-200之间有多少个素数,并输出所有素数。 Sub prog12() ‘ k = 1 For i = 101 To 200 For j = 2 To Int(Sqr(i)) + 1 If i Mod j = 0 Then Exit For End If Next If j = Int(Sqr(i)) + 2 Then Sheet2.Cells(k, 2) = i k = k + 1 End If Next End Sub 【程序13】
‘题目:有1、2、3、4个数字,能组成多少个互不相同且无重复数字的三位数?都是多少? Sub prog13() ‘ Dim a(4) m = 0 ‘m,n,o For i = 1 To 4 a(i) = i Next For i = 1 To 4 For j = 1 To 4 For k = 1 To 4 If ((i <> k) And (i <> j)) And (j <> k) Then m = m + 1 Sheet3.Cells(1, m + 1) = CStr(i) + CStr(j) + CStr(k) End If Next Next Next Sheet3.Cells(1, 1) = m End Sub ‘【程序14】 ‘题目:企业发放的奖金根据利润提成。利润(I)低于或等于10万元时,奖金可提10%;利润高 ‘于10万元,低于20万元时,低于10万元的部分按10%提成,高于10万元的部分,可可提 ‘成7.5%;20万到40万之间时,高于20万元的部分,可提成5%;40万到60万之间时高于 ‘40万元的部分,可提成3%;60万到100万之间时,高于60万元的部分,可提成1.5%,高于 ‘100万元时,超过100万元的部分按1%提成,在sheet3(2,1)中输入月利润I,在sheet3(2,2)中求出发放奖金总数。 Sub prog14() ‘ a1 = 0.1 ‘i<=10 a2 = 0.075 ‘10<i<=20 a3 = 0.05 ‘20<i<=40 a4 = 0.03 ‘40<i<=60 a5 = 0.015 ‘60<i<=100 a6 = 0.01 ‘100<i i = Sheet3.Cells(2, 1) bouns = 0 pp = True Do While pp If i > 100 Then bouns = bouns + (i - 100) * a6 i = i - 100 ElseIf i > 60 And i <= 100 Then bouns = bouns + (i - 60) * a5 i = i - 60 ElseIf i > 40 And i <= 60 Then bouns = bouns + (i - 40) * a4 i = i - 40 ElseIf i > 20 And i <= 40 Then bouns = bouns + (i - 20) * a3 i = i - 20 ElseIf i > 10 And i <= 20 Then bouns = bouns + (i - 10) * a2 i = i - 10 ElseIf i <= 10 Then bouns = bouns + i * a1 Exit Do End If Loop Sheet3.Cells(2, 2) = bouns End Sub 在sheet3的代码输入处输入如下代码: (我在调试时将所有的程序都放在sheet1中) Private Sub Worksheet_Change(ByVal Target As Range) ‘ If Target = Cells(2, 1) Then Sheet1.prog14 End If End Sub ‘【程序15】 ‘题目:有一分数序列:2/1,3/2,5/3,8/5,13/8,21/13...求出这个数列的前20项之和。 Sub prog15() ‘ Dim a(20), b(20) a(1) = 2 b(1) = 1 s = a(1) / b(1) For i = 2 To 20 a(i) = a(i - 1) + b(i - 1) b(i) = a(i - 1) s = s + a(i) / b(i) Next MsgBox CStr(s) End Sub |
|