二级VB习题整理-程序填空部分

l 循环结构1. 以下程序的功能是：从半径5.6开始，按精度0.01递增，求圆面积不超过100的最大半径m，并最后输出该半径，同时要求显示计算过程中的每个圆面积。Const PI = 3.1415926 Private Sub Form_Click() r = 5.6 s = 0 s1 = Do While _ _ r =_+0.01 s= PI * r * r s1 = s1 & s & VbCrLf 存放计算结果,VbCrLf回车换行 Loop m = r - _ _ MsgBox s1 & VbCrLf & m End Sub2. 产生10个不重复的2位随机整数。算法思想是先产生一个随机数tmp，然后在已经存放着不重复随机数的数组a中，查找tmp是否已经存在。如果已经存在，则丢弃，再重新产生；反之，就将tmp存放入数组a中。Private Sub Form_Click() Dim tmp As Integer, i As Integer, j As Integer Dim a(10) As Integer Dim isExist As Boolean 重复随机数标志 Randomize Label1.Caption = 不重复的2位随机整数： i = 0 Do While (i 0 Then Label1.Caption = Label1.Caption & & i count = _ _ If count Mod 5 = 0 Then Label1.Caption = Label1.Caption & vbCrLf End If Next iEnd Sub4. 从键盘输入x值，求出级数的前10项之和，并输出结果。Private Sub Command1_Click() Dim x As Single x = InputBox(请输入X值：) s = 1 t1 = 2 t2 = x t3 = 2 p = -1 For i = 1 To _ s = _ p = -p t1 = t1 + 1 t2 = t2 * x * x t3 = _ Next i Print sEnd Sub5. 求10009999之间的零巧数。零巧数：一个百位数字为0的四位数，如果去掉这个零得到三位数的9倍等于原数。例如2025的百位数是0，去掉这个0，得到225。因为225 * 9 =2025，所以2025是零巧数。函数Shu功能是判断是否是零巧数。其返回值：如果是零巧数，则返回零巧数的三位；否则返回-1。列表框1显示零巧数，列表框2显示对应的三位数。Private Sub Command1_Click() Dim i%, n% For i = 1000 To 9999 n = (1) If n 0 Then 若是零巧数，则添加 List1.AddItem i List2. (2) End If Next iEnd SubFunction Shu(n%) As Integer Dim k%, m% Shu = -1 k = Mid(n, 2, 1) 获取百位数 If (3) Then m = Mid(n, 1, 1) & (4) If m * 9 = n Then Shu = (5) End IfEnd Function6. 回文平方数是指构成的字符左右对称而且等于另一个数的平方，例如：121=11*11、1030301=101*101。下面的程序找出200以内的回文平方数。程序的思想是：将正整数N的平方数转为字符，判断左右是否对称，若是，在文本框内显示所求结果，如图所示。Private Sub Command1_Click() Dim i As Long, j%, k%, flg As Boolean Dim sum As Integer, n As String For i = 1 To 200 flg = n = CStr(i * i) 将要求的数值转为字符 k = Len(n) For j = 1 To k 2 判断是否为回文 If Mid(n, j, 1) Mid(n, , 1) Then flg = False End If Next j If flg Then Text1 = Text1 & CStr( ) & 2= & n & vbCrLf End IfNext iEnd Sub7. 现求1000020000之间的回文数。回文数：一个数正读和倒读都是一样的数。例如12321和10601都是回文数。函数IsShu的功能是判断是否为回文数。其返回值：如果是回文数，则返回True；否则返回False。列表框1显示回文数，标签1显示找出的回文数个数，如图所示。Function IsShu(ByVal n%) As Boolean Dim flag As Boolean, s$, ln%, j% flag = True s = Trim(Str(n) ln = (1) For j = 1 To ln 2 判断回文数 If Mid(s, j, 1) Mid(s, (2) , 1) Then flag = False Exit For End If Next j IsShu = flagEnd FunctionPrivate Sub Command1_Click() Dim m As Integer, i As Integer m = 0 For i = 10000 To 20000 If (3) = True Then 若是回文数，则添加 m = m + 1 List1. AddItem (4) End If Next i Label1.Caption = 共有 & (5) & 个回文数。End Sub8. 下述程序的功能是：找出100以内（含100）自然数对，使两个成对的自然数满足其和与差都是平方数，如26和10，其和为36与差为16均为平方数。程序的思想是：函数过程pf判断自然数是否是平方数，对于自然数i,j,调用函数过程pf，若i + j和j-i同时是平方数，则在列表框内显示i,j。Private Sub Command1_Click() For i = 1 To 100 For j = _ To 100 If _ Then List1.AddItem i & & j End If Next j Next iEnd SubPublic Function pf(x As Integer) As Boolean Dim y As Integer, p As Boolean _ If y * y = x Then _ Else p = False End If _End Function9. 对一个有序数列，压缩掉重复数，并统计重复数出现的次数。算法思想是先将该有序数列存放在数组a中，并输出原始数组数据；然后，扫描该有序序列数组，判别相邻两数是否相同；如果相邻两数相同，通过左移压缩掉重复数，并统计重复次数。Private Sub Form_Click() Dim a(), i%, j%, n As Integer a = Array(2, 3, 4, 5, 5, 5, 6, 7, 8, 8, 8, 8, 9, 9) n = UBound(a) 数组有效上界 m = 0 重复数计数 Label1.Caption = 原始数组数据：For i = 0 To n Label1.Caption = Label1.Caption & a(i) & Next i i = 0 Do While (i (1) ) 找相邻的重复数 If a(i) = a( (2) ) Then m = m + 1 For j = i To n - 1 当有重复数时左移，实现压缩 a(j) = a( (3) ) Next j n = n - 1 数组有效上界更改 Else i = i + 1 End If Loop Label2.Caption = 压缩重复数后： For i = 0 To n Label2.Caption = Label2.Caption & a(i) & Next i Label3.Caption = 统计重复次数： & (4) & 次End Subl 冒泡排序法10. 程序完成对数组s由大到小排序；并将排序结果显示在标签中。Private Sub Command1_Click() Dim s() As Integer Dim k%, j%, n%, t%s = Array(77, 67, 89, 65, 85, 53, 94, 74, 79, 90) n = UBound(s) For j = 0 To n - 1 For k = _ To n If s(j) a(j + 1) Then t = a(j) a(j) = a(j + 1) = t End If Next j Next i For j = 0 To n Picture1. ; ;Next jEnd Subl 插入排序法12. 单击窗体执行将所输入的整数插入排序后的原数组元素适当位置。Function Insert(s(), ByVal key As Integer) As Integer Dim k%, i%, j% k = _(1)_ For i = 0 To UBound(s) If key s(i) Then k = i _(2)_ End If Next i ReDim Preserve s(UBound(s) + 1) For j = UBound(s) - 1 To k Step -1 _(3)_ Next j s(k) = key Insert = UBound(s)End FunctionPrivate Sub Form_Click() Dim a() As Variant, i%, p%, m% a = Array(1, 3, 6, 8, 9, 13, 17, 20, 25) For i = 0 To UBound(a) _(4)_ Next i Print: Print p = InputBox(请输入要插入的数：) m = _(5)_ For i = 0 To m Print a(i); Next i Print: PrintEnd Subl 顺序法查找13. 通过Array函数对数组元素赋初始值，获取数组元素个数n后，输出所有数组元素。从键盘输入一个值key，然后在数组中搜索该值，找到后将该数组元素的值修改为负值（-key），如图所示。Private Sub Form_Click() Dim a(), key%, i%, k%,n% a = Array(3, 9, 1, 7, 10, 5, 8, 4, 6, 2) n = （1） For i = 0 To n Print a(i); Next i Print: Print key = InputBox(key=) 键盘输入要修改的元素 Print 你要修改的元素是; （2） For k = 0 To n If a(k) = key Then 找到该元素 a(k) = （3） Exit For End If Next k If k = （4） Then 修改后重新显示数据 For i = 0 To n Print a(i); Next i Else MsgBox 没有找到！ End IfEnd Subl 求最值和均值14. 下面是十位裁判给一名运动员评分的程序。主调程序通过输入框将10位裁判的评分输入到数组a中，然后调用评分子函数score()计算运动员得分，并将计算结果返回给主调程序输出。计算方法为去掉一个最高分、去掉一个最低分后，剩余八位裁判的平均分为运动员得分。程序的思想是求出10位裁判的总分，并找出一个最高分和一个最低分，将总分减去最高分和最低分，得到有效得分。Private Sub Command1_Click() Dim a(9),j As integer, aver As single For j= 0 to 9 a(j)=InputBox(输入第 & j+1 & 位裁判的分数) Next j Aver = _ _ Label1.text=运动员得分为： & averEnd SubFunction score(ByRef s%() As Single Dim max, min, sum, j, n As Integer n = UBound(s) max = s(0) : min = s(0) sum = _ _ For j = 1 To n If s(j) max Then max = s(j) End If sum = _ _ Next j _ _ = (sum - max - min) / (n-1)End Function15. 以下程序的功能是：随机产生10个两位数的正整数，保存在数组a中，现要求计算该数组中所有能被3整除元素的平均值。Dim a(1 To 10) As IntegerDim i%,n%,s%For i = 1 To 10 a(i) = Int( )+10 Print a(i);Next iPrints = 0n = 0For i = 1 To 10 If = 0 Then s = s + a(i) n = n + 1 End IfNext iPrint 16. 从数据文件C:KSstudent.txt（顺序文件，每行一个数据项）读入学生成绩，在标签中显示平均分。Private Sub Form_Click() Dim s%,n%,fs% s = 0 n = 0 Open C:KSstudent.txt For Input As #1 Do While Not （1） Input #1, fs s = s + （2） n = n + 1 Loop Label1= 平均分 & （3） Close #1End Sub17. 3.单击窗体读当前文件夹中的文本文件data.txt数据，找出其中年龄最大者的年龄、姓名和全部人数，输出并保存在当前文件夹的中result.txt。data.txt的数据格式形如：王海涛, 18李林, 20Private Sub Form_Click() Dim Name$, Age%, maxName$, maxAge% n = 0 maxAge = 0 Open App.Path + data.txt For Input As #1 Do While _(1)_ Input #1, Name, Age n = n + 1 If Age maxAge Then _(2)_ maxName = Name End If Loop Close #1 Label1.Caption = 最大年龄： & maxAge & vbCrLf & 最大年龄姓名： & maxName & vbCrLf & 人数： & n Open App.Path + result.txt _(3)_ Print #2, maxName, maxAge, n Close #2End Subl 公约数18. 以下程序的功能是：求2000以内满足如下条件的正整数对：彼此的全部约数之和(本身除外)与另一方相等。例如220与284:220的全部约数(除掉220本身)相加的和是: 1+2+4+5+10+11+20+22+44+55+110=284 284的全部约数(除掉284本身)相加的和是：1+2+4+71+142=220 程序的思想是：对正整数a，调用函数过程sy(a)求解约数之和b，再次调用函数过程sy(b)求出数b的约数之和t，按定义判断a,b是否满足条件。 sy函数过程求n的所有约数(除本身外)之和Function sy (n As Integer) As Integer Dim sum As Integer, i As Integer sum = 0 For i = 1 To If n Mod i = 0 Then sum = Next i = sum End FunctionPrivate Sub Command1_Click() 求2000以内满足条件的正整数对 Dim a As Integer, b As Integer, t As Integer For a = 2 To 2000 b = sy(a) t = If And a b Then Print a, b Next aEnd Sub6.4素数19. 求1000以内满足如下条件的正整数N： 它的各个因子（包括1和N）之和sum是一个素数。 例如：25的因子为1、5、25，其和 1+5+25 = 31是素数。程序的思想是选取正整数N，分解其因子，并累加，子过程Prime 用于判断累加和是否是素数，若是素数，在文本框内显示所求结果，如图所示。Private Sub Command1_Click() Dim i%, sum%, n%, flg As Boolean, t$ For n = 2 To 1000 sum = 1 t = 1 存放各个因子之和表达式 i = 2 Do While i m Then Call If flg Then Text1 = Text1 & i & vbCrLf End If Next iEnd SubPrivate Sub hws(n As Integer, bz As Boolean) Dim j%, k%, m$ bz = True m = CStr(n) 将数值转为字符 k = 求字符m的长度 For j = 1 To k 2 判断回文数 If Mid(m, k - j + 1, 1) Then bz = False Exit sub End If Next jEnd Subl 分类汇总21. 下面程序的功能是统计文件file1.txt中字母出现的次数（不区分大小写）。程序的思想是：每次从文件中读取一个字符，判断是否是字母。若是字母，计数器加1。Private Sub Command1_Click() Dim num As Integer, c As String * 1 num = 0_ For Input As #2 Do While Not EOF(2) c = Input$(_) 读取一个字符 c = UCase(c) If c = A And c = 0 And c = 9 Then _ 计数器加1 End If LoopClose #3Print 数字字符出现的次数:; aEnd Subl 字符分离23. 文本文件“D:data.txt”存放着10个2位数，每行存放一个数。程序打开该文件，逐个读入数据，存放在数组a中并显示在标签Label1中；然后将每个数的个位数与十位数交换并显示在标签Label2上，请完成填空。 Private Sub Command1_Click() Dim a(10) As Integer, i%, n%, k%, t% Open D:data.txt For (1) As #1 n = 0 Label1.Caption = 原始数据： Label2.Caption = 交换数据： Do While Not EOF(1) 从文件中读入数据 n = n + 1 Input #1, (2) Label1.Caption = Label1.Caption & a(n) & Loop Close #1 For i = 1 To n 个位数与十位数交换 k = a(i) Mod 10 t = (3) a(i) = k * 10 + t Next i For i = 1 To n Label2.Caption = Label2.Caption & a(i) & Next iEnd Sub24. 以下程序的功能是：在文本框Text1内输入身份证号码，单击命令按钮，检查所输入的号码是否为18位，若正确，从身份证号码中分离出出生日期和性别，计算当前年龄，按图示方式显示结果。Private Sub Command1_Click() Dim sfz, y, ss As String Dim m, d As Integer sfz = Text1.Text If （1） 18 Then MsgBox 位数不对,请重新输入！ Text1.Text = Text1.SetFocus End If y = Mid( （2） ) m = Val(Mid(sfz, 11, 2) d = Val(Mid(sfz, 13, 2) Text2.Text = y & 年 & m & 月 & d & 日出生 ss = Mid(sfz, 17, 1) If Val(ss) Mod 2 = 0 Then ss = 女 Else ss = 男 End If Label2.Caption = （3） & ， 现年 & (Year(Date) - （4） ) & 岁End Subl 字符查找25. 以下程序段的功能是：在一个字符串变量str1中查找子串变量str2出现的个数，并显示是否找到及查找到的结果。样例为查找子串at时，找到出现2个的情况。Private Sub Form_Click() Dim str1$, str2$, cd1%, cd2%, n%, i% str1 = Text1.Text str2 = Text2.Text cd1 = Len(str1) cd2 = Len(str2) i = 1 n = 0 Do While i = If Mid(str1, i, ) = str2 Then n = n + 1 End If Loop If Then Label3 = 找到了 & n & 个 Else Label3 = 没有找到！ End IfEnd Sub26. 单击按钮执行在输入样本串中查找字串，删除字串字符后输出至结果文本框。用复选框可选择查找方式是否区分大小写。Private Sub Command1_Click() Dim ss$, s0$, len0%, ms$, i% ss = Text1.Text s0 = Text2.Text If _(1)_ Then s0 =_(2)_ End If len0 = Len(s0) For i = 1 To Len(ss) - len0 + 1 ms = _(3)_ If Check1.Value = 1 Then ms = UCase(ms) End If If (ms = s0) Then ss = Mid(ss, 1, i - 1) + Mid(ss, i + len0) i = i - 1 End If Next i Text3.Text =_(4)_ End Subl 字符排序27. 以下程序的功能是：在文本框Text1内输入一串任意字符(长度不超过50个字符)，分离出单个数字分别存放于数组x中，分离出单个字母分别存放于数组y中，其他字符则丢弃。最后求出这些数字的平均值，以及这些字母中的最小字母,并分别在文本框Text2、Text3显示。程序的思想是：对于每一单个字符c，调用函数过程IsMyChar(c)用来判别c是数字，还是字母，或者是其他字符，并返回相应标志值0、1、-1。Private Sub Form_Click() Dim sp As String, x(1 To 50) As Integer, y(1 To 50) As String Dim i%, m%, n%, s%, t%, s1 As String m = 0: n = 0: s = 0 s1 = Chr(255) 设置最大字符 For i = 1 To Len(_ _) sp = Mid(Text1.Text, i, 1) t = _ _ Select Case t Case 0 m = m + 1 x(m) = Val(sp) s = s + x(m) Case 1 n = n + 1 y(n) = sp If y(n) 0 Then Text2.text = s / m Text3 .Text =s1End SubFunction IsMyChar(c As String) As Integer If c = 0_ _c = A And UCase(c) = Z Then IsMyChar = 1 Else IsMyChar = _ _ End IfEnd Function28. 程序功能是对给定的一串单词，用逗号分隔输出到文本框中，将这些单词按ASCII码从小到大排序，并在单词后加上 * 号显示在标签中，如图所示。 Private Sub Command1_Click() Dim i%, j%, n%, t$, str() str = Array(my, bo