2021年2021年Excel高级应用VBA实验题目解析.docx

精品word 可编辑资料 - - - - - - - - - - - - -Esy021. 选定 sheet1 工作表，合并 A1： C1 单元格，并输入“ TEST”，背景颜色设置为浅黄色，字体颜色设置为红色，字体大小设置为10 磅；Sub Macro1() Macro1 Macro 宏由 xu 录制，时间 : 2021/3/26 Application.Left = 201.25Application.Top = 61.75 Range("A1:C1").Select With Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlBottom.WrapText = False.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = False End With Selection.Merge Range("A1:C1").SelectActiveCell.FormulaR1C1 = "TEST" Range("A1:C1").SelectWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = False.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = True End WithWith Selection.Font.Name = "宋体 ".FontStyle = "常规".Size = 10.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False第 1 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -.Shadow = False.Underline = xlUnderlineStyleNone.ColorIndex = 3 End WithWith Selection.Interior.ColorIndex = 6.Pattern = xlSolid.PatternColorIndex = xlAutomatic End WithEnd Sub2 在 sheet1上创建“窗体”命令按钮并指定“宏”代码sy22 ，补充代码完成：从键盘输入一个整数n，输出如下图形；其中每个“* ”在单元格中水平和垂直方向都要求居中；nSub sy22()Dim n As Integer、 i As Integer、 j As Integer第 1 空n = InputBox(" 输入行数 ")从键盘输入数据并存放到变量n Sheets("Sheet1").Cells.ClearContents清除 sheet1工作表中单元格的内容 For i = 1 To n循环打印，输出n 行"*"For j = 1 To 2 * i - 1 每行输特别数（ 2*i-1) 个"*" ，如：1，3，5 个Cells(i、 n - i + j).Value = "*" Next jNext iCells(1、 n).Activate激活 A 列 N 行的单元格ActiveCell.CurrentRegion.Select 选定单元格所在的当前区域 With Selection.Font.Size = 16 字体大小.Font.Bold = True字体加粗.HorizontalAlignment = xlCenter水平方向居中.VerticalAlignment = xlCenter垂直方向居中第 2 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -End With End subEsy031. 调用 EXCEL 的 RAND 和 INT 内部函数，在 A 列的 1 10 行输入序号 1 10 ， 在 B 列的 1 10 行填入 0 1 之间的随机数， 在 C 列的 1 10 行填入两位正整数， 最终在 C 列的 11 行求出该列的最大数（调用MAX 函数）；请参照程序上下文补充完整的语句Sub sy31()Dim k As IntegerDim a As String、 b As String、 c As String For k = 1 To 10a = "A" & k b = "B" & k c = "C" & kRange(a).Value = k在 A 列的 1-10 行输入序号 1-10Range(b).Value= Rnd()在 B 列的 1-10 行填入 0-1 之间的随机数Range(c).Value= 10 + Int(90 * Rnd()在 C 列的1-10 行填入两位正整数Next kSet myr = Worksheets("Sheet1").Range("C1:C10")Range("c11") = WorksheetFunction.Max(myr)在C 列的 11 行求出该列的最大数（调用MAX函数）End SubEsy04输入一个字符，判定该字符为字母字符.数字字符仍为其他字符，并用Msgbox 函数输出结果；分析：用IF 语句实现Sub pdzi()Dim strC As String定义变量 strC 为字符型strC = InputBox(" 请输入字符 ")第 1 空，利用 InputBox 函数输入字符放到 strC 中IfUCase(strC) >= "A"AndUCase(strC) <= "Z"Then判定输入字符为否为AZ( 其中 UCase函数为将字符转换成大写字符的函数)MsgBox (strC & " 为字母 ")第 2 空，利用 MsgBox 函数输出判定结果ElseIf strC >= 0 And strC <= 9 Then 第 3 空，判定输入字符为否为09 MsgBox (strC & "为数字 ")利用 MsgBox 函数输出判定结果第 3 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -Else第 4 空MsgBox (" 字符" & strC & " 既不为字母， 也不为数字 ")利用 MsgBox 函数输出判定结果End If End Sub2 某学校的职工人事数据存在Excel 工作表中；现要按职称提升每位职工的工资，各种职称的工资增长情形如下：教授150.副教授130.讲师 100.助教80.高级工程师150.工程师 140.助工 90；用 select 语句编写运算增加工资的过程；Sub addsalary()r = ActiveCell.Row活动单元格为要求得增加工资的单元格，运算活动单元格的行号t = Cells(r、 3)第 1 空，定位“职称”所在的单元格 Select Case tCase "教授"、 " 高级工程师 "第 2 空ActiveCell = 150 Case "副教授 "ActiveCell = 130 Case "讲师"ActiveCell = 100 Case "助教"ActiveCell = 80 Case "工程师 "ActiveCell = 140 Case "助工"ActiveCell = 90End Select第 3 空，End Sub3 ：某老师讲授了一门考查课程，他平常及期末考试都用百分制衡量同学的成果，设该老师的成果表如下列图；学校要求最终的成果都用等级制；百分制与等级制的转换规章为：60分以下为不及格，60 70 分为及格， 70 80 分为中等， 80 90 分为良， 90 100 分为优；编写一个百分制与等级制的转换过程实现成果的等级转换；Sub change()score = ActiveCell.Offset(0、 -1).Value 第 1 空Select Case scoreCase Is >= 90第 2 空ActiveCell = " 优" Case Is >= 80ActiveCell = " 良"Case Is >= 70 ActiveCell = " 中"Case Is >= 60 ActiveCell = " 及格"Case Else 第 3 空ActiveCell = " 不及格 "第 4 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -End Select End Sub4 ：打开 Excel 工作簿 EC404.xls ，在 A2 ， B2 和 C2 单元格输入a、 b、 c的值，单击最大值按钮，在 D2 显示这三个数的最大值；解题思路：假设三个数中的第一个数为最大值，用这个假定的最大值分别跟剩下的两个数比较，假如假定的最大值小于其它两个数，就最大值为较大的那个数；Sub max()Dim a As Double、 b As Double、 c As Double、 max As Double a = Val(Cells(2、 1)b = Val(Cells(2、 2)c = Val(Cells(2、 3) max = a 第 1 空If max < b Then max = b 第 2 空End IfIf max < c Then 第 3 空max = c 第 4 空End IfCells(2、 4) = max End Sub5 ：编写程序：创建一简洁应用程序，单击窗体，利用InputBox函数如（图2）所示显示对话框，设定固定密码就为“password”（留意输入的大小写） ；如输入密码正确与否，利用 MsgBox 函数分别显示如（图3）和（图4 ）所示来提示用户输入的密码正确与不正确的 对话框；（图 2）（图 3 ）（图 4）提示：请依据图3 和图 4 中的界面填写第2 空和第 3 空， Msgbox 函数的格式为：Msgbox提示信息，按钮数目及形式，对话框标题Sub pass()t = InputBox(" 请输入密码 "、 " 输入密码 ") If t = "password" Then第 1 空第 5 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -MsgBox " 恭喜你，密码正确！ "、 0、 " 正确 " 第 2 空ElseMsgBox " 对不起！你为非法用户！"、 vbCritical、 " 拒绝"第 3 空End If End SubEsy05试验 1 ： 编写程序，求1+2+3+.+10的和并输出其结果；解题思路：该题用ForNext 结构实现累加；Sub sum()Rem 求 1+2+.+10 的和并输出Dim s As Integers = 0 第 1 空For i = 1 To 10第 2 空s = s + i 第 3 空 Next iMsgBox ("1+2+3+.+10=" & s)第 4 空End Sub试验 2 ：输入任意多个正整数，编写程序求其和与平均值；当输入数小于0 时终止数据的输入；解题思路：该题用Do WhileLoop 结构实现累加，While后面需要有掌握循环为否连续的条件，请留意While 与 Until 的区分；Sub comput()Dim sum As Longsum 用来储存所输入数的和 Dim data As IntegerDim k As Integer k 为记数器，记录输入数的个数k = 0data = InputBox("请输入数据 :")Do While data >= 0第 1 空 sum = sum + data第 2 空 k = k + 1第 3 空data = InputBox("请输入数据 :") LoopMsgBox " 一共输入了 " & k & " 个数； " _& vbCrLf & "其和为 " & sum & " 其平均值为： " & sum / kEnd Sub试验 3 ： 编写程序运算SUM=1+1*2+1*2*3+1*2*3*100的和；解题思路：该题用DoLoop 结构实现累积与累加，目标为求100 项的累加，而每哪一项一个累积式；Sub multi()Dim sum As Double Dim i As Integer Dim t As Double第 6 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -i = 1: t = 1: sum = 0Do While i <= 100 第 1 空t = t * i第 2 空sum = sum + t第 3 空i = i + 1第 4 空LoopMsgBox ("1+1*2+1*2*3+.+1*2*3*.*100=" & sum)End Sub试验 4 ：打开 Excel 工作簿 E504.xls ，编写程序， 将当前工作表中第1 行从指定位置m 开头的 n 个数按相反次序重新排列；例如，原数列为：1， 2 ，3 ， 4， 5， 6 ，7 ，8 ， 9， 10 ， 11， 12 ， 13， 14， 15，16 ，17 ，18 ，19 ，20 ；从第 5 个数开头，将10 个数进行逆序排列，就 得到新数列为：1 ，2 ， 3， 4， 14 ， 13， 12， 11， 10， 9 ， 8， 7， 6，5 ， 15 ， 16， 17， 18 ， 19 ， 20；Sub 逆置()i = Cells(6、 12) 起始位置j = i + Cells(7、 12) - 1 第 1 空，终止位置Do While i < j 第 2 空t = Cells(1、 i)Cells(1、 i) = Cells(1、 j) 第 3 空Cells(1、 j) = t 第 4 空i = i + 1j = j - 1 第 5 空LoopEnd SubEsy06试验 1 ： 打开 Excel 工作簿E601.xls ，编写一个程序，提取字符串中的数字符号；例如，程序运行后输入字符串abc123edf456gh，就输出“ 123456 ”；Sub tq()s = InputBox("请输入一个字符串 :") 输入一个字符串，放在变量s 中n = Len(s)第 1 空，求出 s 的长度，放在变量n 中For i = 1 To na = Mid(s、 i、 1)第 2 空，求字符串 aIf a >= o And a <= 9 Then 第3 空，假如 a 的值为 0 到 9 之间的数字符号，b = b & a第 4 空，就把它拼接到结果字符串变量b 中 End IfNext iMsgBox b输出结果End Sub试验 2 ：打开 Excel 工作簿 E602.xls ，工作表第 1 行有 n 个升序排列的数值，第 2 行有 m 个升序排列的数值，请编写一个程序，将第2 行的数据合并到第1 行中，并保持全部数据升 序排列Sub 合并()第 7 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -r = Rows(1).End(xlToRight).Column 求第一行列数 t = Rows(2).End(xlToRight).Column 求其次行列数For i = 1 To t对其次行的每个数据进行处理 a = Cells(2、 i): Cells(2、 i) = ""取出其次行的一个数据For s = r To 1 Step -1第 1 空 ，从后往前扫描If a >= Cells(1、 s) Then Exit For 第 4 空，退出本层循环Cells(1、 s + 1) = Cells(1、 s)第 2 空，移动数据Next sCells(1、 s + 1) = a 插入数据r = r + 1第 3 空 ，修改目标数据区长度Next 第 5 空End Sub试验 3 ： 在“ D:Esy06 ”文件夹下打开文件EC603.xls ，“求任意区域数值总和”按钮指定到名称为“ sumSelection”的宏，补充宏代码，使之完成如下功能：运算工作表中任意选定区域的数据总和，并用信息提示对话框将结果输出，完成后按原文件名储存在原位置Sub sumSelection()For Each x In Selection第 1 空，”For #1#In Selection“ s = s + x第 2 空Nextmsgbox " 该区域的总和为 :"&s 第 3 空，”msgbox " 该区域的总和为 :"&#3# “End Sub试验 4 ：在“D:Esy06 ”文件夹下打开文件EC604.xls ，“从分班” 按钮指定到名称为 “ Student ”的宏，补充宏代码，使之完成如下功能：按次序（成果从高到低）对同学进行分班，每个班 25 名同学，每个班储存在一个新的工作表中；完成后按原文件名储存在原位置Sub Student() n = 0While Not (IsEmpty(Cells(n + 4、 1) n = n + 1 第 1 空Wendm = Application.WorksheetFunction.RoundUp(n / 25)、 0)bs = 1 DoSheets.AddActiveSheet.Name = Str(bs) + " 班 " Cells(1、 1) = "英语" + Str(bs) + "班名单 " Cells(2、 1) = "学号"Cells(2、 2) = "姓名"Cells(2、 3) = "成果" For i = 1 To 25For j = 1 To 3 第 2 空Cells(i + 2、 j) = Sheets("sheet1").Cells(i + 3 + (bs - 1) * 25、 j) 第 3 空Next Next第 8 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -bs = bs + 1 第4 空 ， #4#Loop While bs <= m 第 5 空， #5#End SubEsy07试验 1 ： 打开文件E701.xls ，“一维数组求极值”按钮指定到名称为“一维数组求极值”的宏，补充宏代码，使之完成如下功能：输入10 个数，将这10 个数分别放在第1 行的 10 个单元格中，求出这10 个数的最大值和最小值放在相对应的单元格中；Sub 一维数组求极值 ()Dim E(1 To 10) As Single第 1 空，定义一个名称为E，元素个数为 10 的一维数组Dim max As Single、 min As Single MsgBox " 输入的 10 个数据如下： "For i = 1 To 10For 语句的作用为先将输入的数据放到数组中，然后再将数组中的数放到对应单元格里E(i) = InputBox(" 请输入数据 :") 第 2 空Cells(1、 i) = i第 3 空Next imax = E(1): min = E(1) For i = 2 To 10If max < E(i) Then max = E(i)第 4 空If min > E(i) Then min = E(i) 第 5 空 Next iCells(2、 2) = max Cells(3、 2) = minEnd Sub试验 2 ： 打开文件E702.xls ，“一维动态数组的使用”按钮指定到名称为“一维动态数组的 使用”的宏，补充宏代码，将整型动态数组X 声明为具有20 个元素的数组，并给数组的全部元素赋值1 ；Sub 一维动态数组的使用 ()Dim X()As Integer第 6 空ReDim X(1 To 20)第 7 空For I = 1 To 20 X(I) = 1 第 8 空Cells(I、 1) = X(I)Next I End Sub试验 3 ： 打开文件E703.xls ，“统计英语成果”按钮指定到名称为“统计英语成果”的宏，补充宏代码， 使之完成如下功能：第一输入该班人数，然后再分别输入该班同学的英语成果并将英语成果依次放在第1 行，将大于平均值的数据以红色字体显示出来；Sub 统计英语成果 () Dim E() As Single Dim n As IntegerDim s As Single、 aver As Single第 9 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -n = InputBox(" 请输入该班的人数 ")ReDim E(n)第 9 空MsgBox " 输入的 " & n & " 个数据如下： " For i = 1 To nE(i) = InputBox(" 请输入英语成果 :")Cells(1、 i) = E(i)s = s + E(i)第 10 空Next iaver = s / n第 11 空MsgBox " 将大于平均值的数据以红色字体显示出来：" For i = 1 To nIf aver < E(i) Then Cells(1、 i).Font.ColorIndex = 3 Next iEnd SubEsy08试验 1 ： 打开文件E801.xls ，“子程序过程求阶乘”按钮指向名称为“子程序过程求阶乘”的宏，第一补充子程序过程Fact 的代码，使之完成阶乘运算；然后，分别用call 语句调用Fact 过程运算出5 的阶乘，用非call 语句调用 Fact 过程运算出8 的阶乘；Sub fact(n As Integer)子程序 fact 求 n 的阶乘 Dim i As Integer、 t As Longt = 1For i = 1 To nt = t * i 第 1 空Next iMsgBox n & " 的阶乘为： " & t第 2 空，输出如下内容“ n 的阶乘为： t”，当程序运行时 n 和 t 都为详细数End SubSub 子程序过程求阶乘 ()Callfact(5) 第 3 空， call 语句调用 Fact 过程运算 5 的阶乘fact 8第 4 空，非 call 语句调用 Fact 过程运算 8 的阶乘End Sub试验 2 ：打开文件E802.xls ，补充自定义函数“Area”的宏代码，第一判定三条边能否组成三角形，假如能就完成三角形面积的运算（三角形面积=(c - x) * (c - y) * (c- z) ），假如不能就输出 "这三条边不能组成三角形！" ，并在 D2:D8 中调用“ Area ”函数；Function area(x、 y、 z) c = (x + y + z) / 2If x + y > z And y + z > x And x + z > y Then 第 5 空，判定三条边能否组成三角形area = (c - x) * (c - y) * (c - z) 1 / 2 第 6 空Elsearea = "这三条边不能组成三角形！"第 10 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -End IfEnd Function试验 3 ：打开文件E803.xls ，补充宏代码，完成如下功能：将当前工作表中第1 行从指定位 置 m 开头的 n 个数按相反次序重新排列；例如，原数列为：1 ，2 ，3 ，4，5 ，6 ，7 ，8，9 ， 10 ，11 ，12 ，13 ， 14， 15 ，16 ，17 ，18 ， 19， 20；从第 5 个数开头，将10 个数进行逆序 排列，就得到新数列为：1， 2， 3， 4， 14， 13 ， 12， 11， 10， 9 ， 8， 7， 6 ，5 ， 15， 16 ，17 ， 18， 19， 20；Sub 逆置()i = Cells(6、 12) 起始位置 j = i + Cells(7、 12) - 1 终止位置Do While i < jCall swap(i、 j)第 7 空，两数交换位置i = i + 1: j = j - 1 第 8 空，调整指针LoopEnd SubSub swap(x、 y)两数交换位置的子过程 t = Cells(1、 x)Cells(1、 x) = Cells(1、 y)第 9 空Cells(1、 y) = t 第 10 空End Sub试验 4 ：打开文件E804.xls ，补充宏代码， 完成如下功能： 提取字符串中的数字符号；例如，程序运行后输入字符串abc123edf456gh，就输出“ 123456 ”；Sub 提取字符串中的数字 ()strs = InputBox("请输入一个字符串 :") 输入一个字符串，放在变量strs 中n = Len(strs) 第 11 空，求出 strs 的长度， 放在变量 n中Call tq(strs、 n、 result)第 12 空，调用提取过程 MsgBox result输出结果End SubSub tq(s、 l、 b)s 为输入字符串， l 为字符串长度， b 为得到的数字字符For i = 1 To l进行 l 次循环a = Mid(s、 i、 1)第 13 空，取 s 中第 i 个字符，放在 a 中 If a >= "0" And a <= "9" Then为数字符号b = b & a第 14 空，拼接到 b 中 End IfNext End Sub试验 5 ： 打开文件E805.xls ，补充宏代码，完成如下功能：将输入的字符反向输出；例如，输入字符串 “abcdef 输”出为 ”fedcba ；”Sub Invert(xStr、 yStr)xStr用来存放原始字符串， yStr用来存放反向后的字符串第 11 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -Dim tempStr As String Dim I As IntegerI = Len(xStr)Do While I >= 1DO 语句实现字符串的反向，基本思路为从右边一个一个的截取字符放到给定变量中， 变量中的字符串即为反向字符串tempStr = tempStr & Mid(xStr、 I、 1)第 15 空 I = I - 1LoopyStr = tempStr第 16 空End SubSub 字符反向输出 ()Dim s1 As String、 s2 As Strings1 = InputBox("请输入字符串： ")Call Invert(s1、 s2)第 17 空MsgBox s2 End SubEsy11 期中考1. 请打开试验文件夹下的sy01.xls 文件，完成如下操作：编程序，打印九九乘法表如下；其中乘数和被乘数所在单元格字符格式为加粗，水平居中；Sub jiujiu()Dim i As Integer、 j As Integer For i = 1 To 9Cells(1、 i + 1).Value = i 第 1 空， #(1)#.Value = i生成乘法表的第1 行Cells(i + 1、 1).Value = i 第 2 空， #(2)#.Value = i生成乘法表的第1 列 Next iRows(1).Font.Bold = True第 3 空#(3)#.Font.Bold = TrueRows(1).HorizontalAlignment = xlCenterColumns(1).Font.Bold = True第 4 空#(4)#.Font.Bold = True Columns(1).HorizontalAlignment= xlCenter 第 5 空 Columns(1).#(5)# = xlCenter第 12 页，共 14 页 - - - - - - - - - -精品word 可编辑资料 - - - - - - - - - - - - -For i = 1 To 9For j = 1 To i 第 6 空 For j = #(6)# Cells(i + 1、 j + 1).Value = i * j 第 7 空#(7)# = i * jNext j Next i End Sub2.请打开试验文件夹下的sy02.xls 文件，完成题目要求的操作；Sub 男生分班 ()Sub 男生分班 () Dim k As IntegerFor Each sht In Worksheets检查“男生”工作表为否存在，假如存在就删除If sht.Name = " 男生" Then Sheets("男生").DeleteSheets("男生").#（ 1）#NextSheets.Add建立男生工作表及表头信息 Range("a1:d1").Merge#（2）#.MergeActiveSheet.Name = "男生"#（3）# = " 男生"活动工作表的名字为“男生”Range("A1:D1").Value = "2000 级男生信息表 " Range("A1:D1").#（ 4）#= "2000 级男生信息表 "Range("A2").FormulaR1C1 = Sheets("同学成果 ").Range("A3").Value Range("B2").FormulaR1C1 = Sheets("同学成果 ").Range("B3").ValueRange("C2").FormulaR1C1 = Sheets(学"生成果 ").Range("C3").ValueRange("D2").FormulaR1C1 = Sheets("同学成果 ").Range("D3").Value- 从“同学成果表”中提取男生成果并赋值给“男生”工作表- k = 3k 为男生表中每位同学记录的插入位置For i = 4 To Sheets("同学成果 ").Range("a65536").End(xlUp).Row 从第 4 行到工作表最终一行，读取同学成果表全部数据If Sheets("同学成果 ").Cells(i、 3).Value = " 男" Then假如性别为男，就提取数据For j = 1 To 4j 为同学数据的四个列Cells(k、 j)= S