练习题编程答案

第3章

6．

（1）答案

'计算1至20平方的和

Function countpf() As Long Dim sum As Long sum = 0

For i = 1 To 20 sum = sum + i * i Next Return sum End Function

（2）答案

Function counthe() As Long Dim sum As Long sum = 0 For i = 1 To 3 For j = 1 To i sum = sum + j Next Next Return sum End Function

（3）答案

Function countfs() As Double Dim sum As Double Dim fh As Integer fh = 1 sum = 0

For i = 1 To 19 Step 2 sum = sum + 1 / i * fh fh = -fh Next Return sum End Function

7．答案

Function countsum() As Long Dim a(39) As Long a(0) = 0 a(1) = 1 For i = 2 To 39

a(i) = a(i - 2) + a(i - 1) Next

For j = 0 To 39 Debug.Print(a(j)) Next End Function

8．答案

Function getsws(ByVal x As Single) As Single Dim i, j As Integer Dim fstr As String

Dim gw, sw, bw, qw As String Dim fresult As Single Fresult = 0

For i = 1000 To 9999 Fstr = i.tostring gw = mid(fstr, 4, 1) sw = mid(fstr, 3, 1) bw = mid(fstr, 2, 1) qw = mid(fstr, 1, 1)

If (gw = sw And bw = qw) Then For j = 10 To 99 If i = j * j Then Fresult = i Exit For End If Next j End If

If fresult <> 0 Then Exit For Next i

Return fresult End Function

9．略，请参考书本

10．略，自行在电脑上运行查看结果

11．答案

'求所有元素之和

Function getsum(ByVal x(,) As Long) As Long Dim sum As Long sum = 0 For i = 0 To 9 For j = 0 To 9

sum = sum + x(i, j) Next Next Return sum End Function

'求数组的靠边元素之和

Function getcornersum(ByVal x(,) As Long) As Long Dim sum As Long sum = 0 '求第1行的和 For i = 0 To 9

sum = sum + x(0, i) Next

'求第2至9的和 For j = 1 To 8

sum = sum + x(j, 0) + x(9, j) Next '求第10的和 For k = 0 To 9

sum = sum + x(9, k) Next Return sum End Function

'主对角线各元素之乘积

Function getzdjcj(ByVal x(,) As Long) As Long Dim sum As Long sum = 1 For i = 0 To 9

sum = sum * x(i, i) Next Return sum End Function

12．答案

'十进制数转二进制数

Function convet10to2(ByVal x As Integer) As String Dim ftostr As String Dim fvalue As Integer fvalue = x ftostr = \

Do While fvalue >= 2

ftostr = (fvalue Mod 2).ToString + ftostr fvalue = fvalue \\ 2 Loop

ftostr = fvalue.ToString + ftostr Return ftostr End Function

'十进制数转八进制数

Function convet10to8(ByVal x As Integer) As String Dim ftostr As String Dim fvalue As Integer fvalue = x ftostr = \

Do While fvalue >= 8

ftostr = (fvalue Mod 8).ToString + ftostr fvalue = fvalue \\ 8 Loop

ftostr = fvalue.ToString + ftostr Return ftostr End Function

'十进制数转十六制数

Function convet10to16(ByVal x As Integer) As String Dim ftostr As String Dim fvalue As Integer Dim mys As Integer fvalue = x ftostr = \

Do While fvalue >= 8 mys = fvalue Mod 16 Select Case mys Case 10

ftostr = \ + ftostr Case 11

ftostr = \ Case 12

ftostr = \ + ftostr Case 13

ftostr = \ + ftostr Case 14

ftostr = \ + ftostr Case 15

ftostr = \ + ftostr Case Else

ftostr = mys.ToString + ftostr End Select

fvalue = fvalue \\ 16 Loop

ftostr = fvalue.ToString + ftostr Return ftostr End Function

13．略，比较简单，大部分同学已经做出来 关键是使用字符串函数Mid（）

14．略，比较简单，大部分同学已经做出来。

第4章

2．答案

'判断传入的整数是否是素数

Function judgess(ByVal x As Integer) As Boolean Dim isss As Boolean isss = True For i = 2 To x For j = 2 To x If i * j = x Then isss = False Exit For End If Next

If isss = False Then Exit For End If Next Return isss

End Function

3．答案

'求两个数的最大公约数

Function zdgys(ByVal x As Integer, ByVal y As Integer) Dim gys As Integer gys = 1

For i = x To 2 Step -1 If x Mod i = 0 Then If y Mod i = 0 Then gys = i Exit For End If End If Next Return gys End Function

'求两个数的最小公倍数

Function zxgbs(ByVal x As Integer, ByVal y As Integer) Dim gbs As Integer gbs = x

Do While (gbs Mod x <> 0 Or gbs Mod y <> 0) gbs = gbs + 1 Loop Return gbs End Function

4．答案

'定义阶乘计算递归函数

Function fact(ByVal x As Integer) As Long If x = 1 Then Return 1 Else

Return (x * fact(x - 1)) End If End Function

'计算1！+2！+3！+...+10！

Function countjc(ByVal x As Integer) As Long Dim sum As Long sum = 0

'For i = 1 To 10 For i = 1 To x

sum = sum + fact(i) Next Return sum End Function

5．略，请参考书上类似的做法 6．答案

'求数组最大值

Function getmax(ByVal x() As Double) As Double Dim fmax As Double

Dim fubound As Integer '记录数组的最大下标 fubound = UBound(x, 1) fmax = x(0)

For i = 1 To fubound If fmax < x(i) Then fmax = x(i) End If Next Return fmax End Function

'求数组最小值

Function getmin(ByVal x() As Double) As Double Dim fmin As Double

Dim fubound As Integer '记录数组的最大下标 fubound = UBound(x, 1) fmin = x(0)

For i = 1 To fubound If fmin > x(i) Then fmin = x(i) End If Next Return fmin End Function

'主调函数 Sub getvalue()

Dim x(11) As Double For i = 0 To 11

x(i) = Val(InputBox(\请输入\ + (i + 1).ToString + \月份的产值\)) Next

MsgBox(\全年12个月最高月产值为：\ + getmax(x).ToString) MsgBox(\全年12个月最低月产值为：\ + getmin(x).ToString) End Sub

本文来源：https://www.bwwdw.com/article/8qrp.html