2022年vba编程题库 .pdf

《2022年vba编程题库 .pdf》由会员分享，可在线阅读，更多相关《2022年vba编程题库 .pdf（8页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。

1、1、 编一个 VBA程序，将 Word当前文档中光标右边的大写字母转换为小写字母。 Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend n= Asc(Selection.Text) If n = 65 And n = 90 Then Selection.TypeText Text:=Chr(n + 32) Else Selection.MoveRight Unit:=wdCharacter, Count:=1 End If 2 、 编一个 VBA程序，在Word 当前文档中按顺序输入26个英文字母。For i =

2、Asc(a) To Asc(z) Selection.TypeTextText:=Chr(i) Next 3、新建一个窗体，放置两个按钮和一个文字框控件。按钮的标题分别定义为 “显示”和 “清除” 。单击“显示”按钮，在文字框中显示一行文字，单击“清除”按钮，清除文字框中的文字。进入 VBA编辑环境，打开“工程资源管理器”窗口，插入一个用户窗体。在窗体上放置两个命令按钮和一个文字框。 右 击命 令按 钮 , 选 “ 属性” ， 设置 Caption 属性值为“显示” 、 “清除”。双击“显示”命令按钮，输入如下代码： Me.TextBox1.SetFocus Me.TextBox1.Text

3、= 你好！欢迎学习 VBA 双击“清除”命令按钮，编写代码如下： Me.TextBox1.Text = 双 击 用 户 窗 体 ， 为 其Activate事件编写如下代码： Me.Caption = 欢迎！4、假设某文件夹有20 个属性相同、命名有规律（比如：pic01.gif、pic02.gif、, 、pic20.gif）的图片文件，现在要依次放入PowerPoint幻灯片中，并调整为合适的格式。，录制宏 输入标题、 插入图形、调整格式。加工录制的程序。设置路径、循环、使用变量。运行程序。5、编写一个自定义函数，根据“工资及津贴” 数额求出应缴纳党费的比例。Function df(x) Se

4、lect Case x Case Is = 400 y = 0.005 Case Is = 800 y = 0.01 Case Is = 1200 y = 0.015 Case Is = 1500 y = 0.02 Case Else y = 0.03 End Select df = y End Function 6、用递归方法编写一个函数，求 n 的阶乘。 Function fact(n) If n = 1 Then fact = 1 Else fact = n * fact(n - 1) End If End Function 7、要想在Excel 工作簿的任意一个单元格中输入数字“1”后

5、，自动替换为符号“” ，建立 Excel 工作簿，进入 VB编辑环境，对ThisWorkbook 的SheetChange 事件 编写如 下程序：Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Value = 1 Then Target.Value = End Sub 8、在 Word中，要想用快捷键执行宏的方式快速将某一字符变为上角标录制新宏，设置快捷键，进行宏录制。选中字符，在“字体”窗口的“效果”栏中选中“上标”，停止录制宏。光标定在字符左边，按快捷键，即可转换为上

6、角标。9、假设Excel 当前工作表的A列是应参加会议人员名单，要求当每个与会人员报道时，在其姓名右边的单元格（B 列）单击鼠标，自动填入当前日期和时间。建立Excel工作簿，进入VBA编辑环境，对WorkSheet 的SelectionChange事件编写如：PrivateSubWorksheet_SelectionChange(ByVal Target As Range) col_s = Target.Column If col_s = B Then Target.Value=Format(Now,yyyy-mm-dd hh:mm:ss) End If End Sub 10、假设在 Exc

7、el 工作表中已经建立一个“XX高校教师信息表” 。进入 VBA编辑环境， 在当前工程中插入一个模块， 建立如下自定义 函 数： Function age(id As String)id = Trim(id) If Len(id) = 18 Then age = Year(Date) - Val(Mid(id, 7, 4) Elseage = Year(Date) - Val(19 + Mid(id, 7, 2) End If 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 1 页，

8、共 8 页 - - - - - - - - - 在“年龄”列第一个单元格输入计算公式“ =age(X) ” ，其中X 是对应的身份证号单元格地址，并将公式填充到该列的其他单元格。11、编写程序，将Excel 任意选定的两个单元格的内容互换 Sub ChangV() v = ActiveCell.Value For Each a In Selection Ifa.AddressActiveCell.Address Then ActiveCell.Value = a.Value a.Value = v End If Next End Sub 12、 编写程序，在打开 Excel时提示密码输入， 如

9、果错误则使用Application.Quit退 出Excel 。Sub auto_Open() If Application.InputBox(请输入密码 : ) = 123 Then Exit Sub Else Application.Quit End If End Sub 13、编写一段程序，求某门课程的平均分。要求用InputBox函数输入学生的人数和每个人的分数，用MsgBox 语句输出平均分。 Sub pjf() rs = InputBox(输入学生的人数： ) zf = 0 For k = 1 To rs f = InputBox(输入考试成绩 & k) zf=zf+f Next

10、MsgBox (rs & 位学生的平均分是： & zf / rs) End Sub 14、设计一个判断三角形是否为直角三角形的子程序，它带有三个整型参数a、b 和 c 分别表示三角形的三条边。Sub cag(a As Integer, b As Integer, c As Integer) If a 2 + b 2 = c 2 Or a 2 + c 2 = b 2 Or b 2 + c 2 = a 2 Then MsgBox 是直角三角形 Else Msgbox 不是直角三角形 End If End Sub 15、要想在 Excel 工作簿打开时建立一个名为“功能”的工具栏，在工具栏上添加一个

11、按钮（按钮的capition任意，要执行的过程名任意） ，并且让工具栏可见。请写出工作簿Open 事件的子程序。Private Sub Workbook_Open() Settbar= Application.CommandBars.Add(Name:= 功能 ) Setbutt=tbar.Controls.Add(Type:=msoControlButton) With butt .Caption = 取字模 .Style= msoButtonCaption .OnAction = qzm End With tbar.Visible = TrueEnd Sub 16、编写一个子程序，使用工作

12、表函数求出“Sheet1 ”工作表 A1:D10 区域中的最小值。Sub aa() Dim myR As Range SetmyR=Worksheets(Sheet1).Range(A1:D10) b=Application.WorksheetFunction.Min(myR) MsgBox b End Sub 17、编写一个子程序，将Excel 当前工作表 “A1:H8”区域的每行填涂一种不同颜色。Sub kk() For i = 1 To 8 For j = Asc(A) To Asc(H) c = Chr(j) & i Range(c).Interior.ColorIndex = i N

13、ext j Next i End Sub 18、假设 Excel 当前工作表是某个班级学生成绩单 （50 人） ，第一列是姓名，第二、三、四列是三科成绩，试编一段 VBA程序，通过输入框输入姓名后，查询并显示该学生的三科成绩和总成绩。 xm = InputBox(请输入姓名： ) For I = 1 To 50 If Range(A & I) = xm Then cj1 = Range(B & I) cj2 = Range(C & I) cj3 = Range(D & I) zcj = cj1 + cj2 + cj3 MsgBox 该生成绩分别为： & cj1 & cj2 & cj3 & 总成

14、绩为： & zcj End IfNext 19、 编写一段程序， 在 Excel工作簿中添加一个叫“选择模板”的工具栏，在工具栏上添加两个按纽叫“开始”和“退出”并分别调用KS 、TC两个子程序。Settbar=Application.CommandBars.Add(Name:= 选择模板 ) Set butt1 = tbar.Controls.Add With butt1 .Caption = 开始 .OnAction = ks End With Set butt2 = tbar.Controls.Add With butt2 .Caption = 退出 .OnAction = tc End

15、 With tbar.Visible = True 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 2 页，共 8 页 - - - - - - - - - 20、编写一个求斐波那契数列第 n 项值的递归函数。 该数列为： 1 1 2 3 5 8 13 21, 。Function fib(n) If n = 1 Or n=2 Then fib = 1 Else fib = fib(n - 1) + fib(n - 2) End IfEnd Function 21、编写一个子程序，在Ex

16、cel 当前工作表的F5 到 J28填入 1 到 5 之间的随机整数。Sub mnsj() For i = 5 To 28 For j = 6 To 10 Cells(i,j) = Int(Rnd * 5) + 1 NextNextEnd Sub 22、编写一个子程序，当工作簿中工作表被切换时，对工具栏中按钮的可用性进行控制。要求当前工作表为“总分”或“信息”时，使工具栏按钮“butt1 ”不可用，否则可用。PrivateSubWorkbook_SheetActivate(ByVal Sh As Object) If Sh.Name = 总 分 Or Sh.Name = 信息 Then But

17、t1.Enabled = False Else Butt1.Enabled = True End IfEnd Sub 23、在工作簿打开时，首先显示封面窗体UserForm1，然后建立一个工具栏命名为“竞赛评分” ，在工具栏上添加一个命令按钮“汇总”，为按钮指定17 号图符，并指定要执行的过程为“hz” 。Private Sub Workbook_Open() UserForm1.Show Settbar=Application.CommandBars.Add(Name:= 竞赛评分 ) Setbutt=tbar.Controls.Add(Type:=msoControlButton) Wit

18、h butt .Caption = 汇总 .FaceId = 17 .Style=msoButtonIconAndCaption .OnAction = hz End WithEnd Sub 24、编写一个子程序，将当前 Word 文档选中的文本所有单词“ ABC ”替换为“ VBA ” 。Sub cz() With Selection.Find .Text = ABC .Replacement.Text = VBA .Execute Replace:=wdReplaceAll End WithEnd Sub 25 、 编 写 一 个 子 程 序 ， 求Range(“A2:A20”) 区域中数

19、据的平均值，填入Cells （2，3）中。要求四舍五入，保留小数点后两位。Sub 平均值 () zf = 0 For i = 2 To 20 zf = zf + Cells(i, 1) Next i Cells(2, 3).Value = Int(zf / 19 * 100 + 0.5) / 100 End Sub 26 、 编 写 一 个 子 程 序 ， 求Range(“A2:A20”) 区域中数据的最大值和最小值 （假设数据的范围在 0 到 100 之间），并用消息框的形式显示出来。Sub dxz() Set myr = Range(a2:a20) a=Application.Worksh

20、eetFunction.Min(myr) b=Application.WorksheetFunction.Max(myr) MsgBox 最大值为: & b & Chr(10) & 最小值为 : & a End Sub 27、已知工作表中第1 列从第 1行开始到第 40行有 40 个考试成绩数据， 试编写一个子程序求出最高分并用消息框显示出来。Sub zg() zgf = Range(A1) For i = 1 To 40 If Range(A & i) zgf Then zgf = Range(A & i) End If Next MsgBox 最高分是 : & zgf End Sub 28

21、、已知当前工作表“A1:A60”区域是某考查课成绩，试编写一个子程序求出“良好”人数并将“良好”单元格填充上颜色。Sub gs() k = 0 For h = 1 To 60 If Cells(h, 1) = 良好 Then Cells(h,1).Interior.ColorIndex = 5 k = k + 1 End IfNext MsgBox 良好的人数 : & k End Sub 29、已知当前工作表第1 列有 1000 个无规则的数据，有的单元格为空， 有的单元格里前几个字符是空格。 试编写一程序删除空单元格， 将单元格内容前面的空格去掉， 最后计算有多少个非空单元格。k = 100

22、0 For i = 1 To 1000 Range(A & i) = Trim(Range(A & i) If Range(A & i) = Then Range(A & i).Delete k = k - 1 End If Next 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 3 页，共 8 页 - - - - - - - - - 30、编写一段程序，将Excel 当前工作簿“ Sheet1 ”第一行的内容按原位置粘贴到“Sheet2 ”中Worksheets(Sheet1).

23、Rows(1).Copy Worksheets(Sheet2).Rows(1) 31、 设计一个子程序， 找出 100800 范围内所有能同时被3 和 8整除的自然数， 依次填写到当前工作表的第一列。Sub 方法 1() i = 1 For n = 100 To 800 If (n Mod 3 = 0) And (n Mod 8 = 0) Then Cells(i, 1).Value = n i = i + 1 End If Next n End Sub 32、编写一个子程序，任意输入两个正整数， 求它们的最大公约Sub aa() m = InputBox(请输入第一个正整数 ) n = In

24、putBox(请输入第二个正整数 ) If n m Then t = m: m = n: n = t Do p = m Mod n m = n n = p Loop While p 0 MsgBox m End Sub 33、用 VBA编写一个四舍六入函数 Public Function sslr(x, n) x = x * 1000 x = Str(x) p = InStr(x, .) y = Mid(x, p + 1, 1) If y 5 Then j = 1 ElseIf y = 5 Then q = Mid(x, p - 1, 1) If q Mod 2 = 0 Then j = 0

25、Else j = 1 End If Else j = 0 End If x = Left(x, p - 1) x = Val(x) + j sslr = x / 1000 End Function 34、单元格A1内容为字符串 “月、2 月、3 月.10月、11 月、12 月” ，请用 vba 实现把“月”删除，将单元格A1内容变为“ 1、2、3.10、11、12”A1=Application.WorksheetFunction.Substitute(A1, 月, ) 35、在工作表sheet2中使用 Worksheet_Activate()事件，实现单击 Sheet2 时，在 Sheet1的

26、 A列的最后一个记录的下一行自动填上“ End” 。PrivateSubWorksheet_Activate() dim i as integer i= Sheets(Sheet1).Cells(1, 1).CurrentRegion.Rows.Count Sheets(Sheet1).Cells(i + 1, 1) = End End Sub 36、编写程序，在打开Excel 表格时提示输入密码，共有三次机会，三次错误后退出应用程序。Sub auto_Open() If Application.InputBox(请输入操作权限密码:, 系统登陆) = 123 Then Else MsgBox

27、 密码错误 , 请重输, vbCritical + vbOKOnly, 你还有两次机会 If Application.InputBox(请输入操作权限密码:, 系统登陆) = 123 Then Else MsgBox 密码错误 , 再给你一次机会 !, vbCritical + vbOKOnly, 你还有一次机会 If Application.InputBox(请输 入 操作 权限 密 码 :) = 123 Then Else MsgBox 你无权进入本系统! , vbCritical + vbOKOnly, 你没有机会啦 ! Application.Quit End IfEnd IfEnd

28、IfEnd Sub 37、Excel 中列号用字母表示，列号 9，对应的字母应该是I,列号27，对 应的字 母应 该是AA。用 vba 编写一个函数，将列号转变为对应的字母。（最大列号为 256）FunctionColumnLetter(ColumnNumber As Integer) As String If ColumnNumber 256 Then MsgBox 无效列号 Exit Function ElseIf ColumnNumber 26 Then ColumnLetter=Chr(Int(ColumnNumber - 1) / 26) + 64) & _ Chr(ColumnNu

29、mber - 1) Mod 26) + 65) ElseColumnLetter=Chr(ColumnNumber + 64) End IfEnd Function 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 4 页，共 8 页 - - - - - - - - - 38、简单描述并编程实现下列过程 ： 在 打 开 一 个 主 文 件“main.doc ”的同时，相关的其他 三 个文 件 自动 打 开“test.doc” 、 “answer.doc ”及“chart.doc” 。进

30、入 VBE环境，用“工程资源管理器”选择“main”工程，在该工程的“ Microsoft Word”对象中双击“ This Document ” ，对 Document 对象的 Open事件编写如下代码：PrivateSub Document_Open() Documents.Open FileName:=test.doc Documents.Open FileName:=answer.doc Documents.Open FileName:=chart.doc End Sub 39、编程实现在文档的末尾插入该文档每次被打开的时间。在用户打开文档时发生该事件。PrivateSub Docum

31、ent_Open() Dim rngCurrent As Range SetrngCurrent= ActiveDocument.Content With rngCurrent .collapse wdCollapseEnd .InsertDateTime”MM/dd/yy HH:MM:SS ”,False End with SetrngCurrent= ActiveDocument.Content With rngCurrent .InsertParagraphAfter .Collapse wdCollapseEnd .Select End with End Sub 40、编程序，将八进制

32、正整数组成的字符串转换为十进制整数。Sub kk() b = InputBox(请输入一个八进制数： ) n = Len(b) s = 0 For i = 1 To n k = Mid(b, i, 1) s = s * 8 + k Next MsgBox s End Sub 41、 编写一个循环程序， 计：s=1+12+123+1234+12345+. 。项目数通过键盘指定。Sub kk() n = InputBox(n=?) s = 0: t = 0 For i = 1 To n t = t * 10 + i s = s + t Next MsgBox s End Sub 0170 06F3

33、 42、编写程序检查一个字符串是否 为 回 文 ， 是 回 文 时 ， 输 出“yes! ” ，否则输出“no! ” 。所谓回文即正向与反向的拼写都一样，例如： adgda。Sub kk() s = InputBox(请输入一个字符串： ) n = Len(s) p1 = 1: p2 = n Do While p1 p2 If Mid(s, p1, 1) Mid(s, p2, 1) Then MsgBox No! Exit Sub End If p1 = p1 + 1 p2 = p2 - 1 Loop MsgBox Yes! End Sub 42、编程将 Excel 当前工作表第 1 行的所有

34、数据元素逆置。Sub kk() i = 1 j=Rows(1).End(xlToRight).Column Do While i j t = Cells(1, i) Cells(1,i)= Cells(1, j) Cells(1, j) = t i = i + 1: j = j - 1 Loop End Sub 43 、 编 写 一 个 程 序 ， 将Excel如图所示的原数据区的数据复制到目标数据Sub 方法之一 () For k = 1 To 8 r = 11 + (k - 1) Mod 4) * 5 c = IIf(k 1 And i = 0 And a = 9 Then b = b &

35、 a End If Next MsgBox bEnd Sub 50、编写程序，输出所有“对等数” 。 “对等数”是指一个三位数，其各位数字的和与各位数字的积的积等于该数本身。例如：144(1+4+4)*(1*4*4) 。Sub kk() For n = 100 To 999 i = n 100 j = n 10 - i * 10 k = n Mod 10 If n = (i + j + k) * i * j * k Then Selection.TypeText Text:=Format(n, ) End If NextEnd Sub 51、编写一个双重循环结构的 VBA程序，在Word当前文

36、档输出如下形式的方阵： For j = 4 To 1 Step -1 For i = 1 To 4 x = (j - 1) * 4 + i Selection.TypeTextText:=Format(x,) Next Selection.TypeParagraph Next 0182 07F2 52、在 Word 中编写一个双重循环结构的VBA程序，实现如下功能：输入一个整数给n（n10）后，输出 n 行由大写字母A 开始构成的三角形字符阵列图形。例如，输入整数5 时，程序运行结果如下：A B C D E F G H I J K L M N O n = InputBox(n=?) c = A

37、sc(A) For i = 1 To n For j = 1 To n - i + 1 Selection.TypeText Text:=Format(Chr(c), ) c = c + 1 Next Selection.TypeParagraph Next 53、100 匹马驮 100 担货，大马一匹驮 3 担，中马一匹驮2 担，小马两匹驮1 担。请编一个VBA程序，求大、中、小马可能的数 For x = 0 To 33 For y = 0 To 50 z = 100 - x - y If 3 * x + 2 * y + 0.5 * z = 100 Then g = g & 大马 & x &

38、 ,中马 & y & ,小马 & z & Chr(10) End IfNext NextMsgBox (g) 54、设 Excel 当前工作表第一行有 n 个升序排列的数值，第二行有 m个升序排列的数值。编一个VBA程序，将第二行的数据合并到第一行中且保序。n=Rows(1).End(xlToRight).Column 求第一行列数名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 6 页，共 8 页 - - - - - - - - - m=Rows(2).End(xlToRight).

39、Column Fori=1Tom a = Cells(2, i) For j = n To 1 Step -1 If a Max Then Max = Cells(Row, col) End If Next If Row = 1 Then Min = Max ElseIf Max 0 Then n1 = Val(tt) n2 = Val(Mid(tt, p + 1) k = n2 - n1 + 1 Else k = 0 p = InStr(tt, A) Do While p 0 k = k + 1 p = InStr(p + 1, tt, A) Loop End If MsgBox i & 行

40、 & j & 列单元格有 & k & 个“ A ” 。 NextNext 58、在 Word 当前文档中，显示 Fibonacci （斐波那契）数列的前 30 项。Sub 递推方法 () f1 = 1 f2 = 1 Selection.TypeText Text:=f1 & & f2 & For N = 3 To 30 f3 = f1 + f2 Selection.TypeText Text:=f3 & f1 = f2 f2 = f3 NextEnd Sub 59、五只猴子分一堆桃子。第一只猴子把桃子均分成五份后，发现多一个，它吃掉这个桃子，并拿走了其中的一份。第二只猴子把剩余的桃子均分成五0

41、189 Sub 方法 1() n = 6 Dos=n k=0 For m = 4 To 1 Step -1 s = (s / 4) * 5 + 1 If Int(s) = s Then k = k + 1 Next n = n + 5 Loop Until k = 4 MsgBox ( 至少应该有 & s & 个桃子！ )End Sub 60、在 Word 中，用 VBA程序在一定范围内验证哥德巴赫猜想：任何一个大于5 的偶数，可以表示为两个素数之和。Sub out_e() n = 6 Doj = 2 DoIf isprime(j) And isprime(n - j) Then Select

42、ion.TypeText Text:=n & = & j & + & n - j & Chr(10) Selection.EndKeyUnit:=wdStory Exit Do End If j = j + 1 Loop n = n + 2 Loop End Sub Function isprime(n) For k = 2 To Sqr(n) If n Mod k = 0 Then isprime = False Exit Function End IfNext isprime = TrueEnd Function 61、编写一个能随机产生算术运算符 （+、- 、* 、/ ）的函数。 Pub

43、lic Function ysf() x = Int(Rnd() * 4) Select Case x Case 0 ysf = + Case 1 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 7 页，共 8 页 - - - - - - - - - ysf = - Case 2 ysf = * Case 3 ysf = / End Select End Function 61、公鸡每支5 元，母鸡 3元，小鸡 3 支 1 元。用 100 元买100 只鸡，问公鸡、母鸡、小鸡各多少只

44、？ For x = 0 To 19 For y = 0 To 33 z = 100 - x - y If 5 * x + 3 * y + z / 3 = 100 Then g = g & 公鸡 & x & ,母鸡 & y & ,小鸡 & z & Chr(10) End IfNext Next MsgBox (g) 62、编写一个 VBA程序，分解出给定整数的所有因子并输出。k = InputBox(请输一整数： ) g = k & = & Sgn(k) k = Abs(k) For i = 2 To k 2 Do While k Mod i = 0 g = g & * & i k = k i Loop Next If k 1 Then g = g & * &k MsgBox g 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 8 页，共 8 页 - - - - - - - - -