VBA程序设计用例：程序流程图及程序代码
vba简单编程案列
以下是一个简单的VBA编程案例，用于在Excel中创建一个简单的计算器程序。
该程序将接受用户输入的数字和运算符，并返回结果。
```vbaSub Calculator()Dim num1 As DoubleDim num2 As DoubleDim operator As StringDim result As Double' 获取用户输入num1 = InputBox("请输入第一个数字")operator = InputBox("请输入运算符（+, -, *, /）")num2 = InputBox("请输入第二个数字")' 根据运算符进行计算Select Case operatorCase "+"result = num1 + num2Case "-"result = num1 - num2Case "*"result = num1 * num2Case "/"If num2 <> 0 Thenresult = num1 / num2ElseMsgBox "除数不能为零"Exit SubEnd IfCase ElseMsgBox "无效的运算符"Exit SubEnd Select' 显示结果MsgBox "结果：" & resultEnd Sub```这个程序首先通过`InputBox`函数获取用户输入的两个数字和一个运算符。
然后，使用`Select Case`语句根据运算符执行相应的计算，并显示结果。
如果用户输入了无效的运算符或除数为零，程序会显示一个错误消息。
这个简单的VBA编程案例可以帮助用户快速创建自己的计算器应用程序，并在Excel中进行基本的数值计算。
excelvba编程实例
excelvba编程实例Excel VBA编程实例：创建一个销售数据分析报告在这个Excel VBA编程实例中，我们将一步一步地回答如何创建一个销售数据分析报告。
这个报告将会根据数据表中的销售数据生成销售额、销售量和利润率的统计信息，并在一个新的工作表中进行展示。
第一步：准备数据首先，我们需要准备一个包含销售数据的数据表。
数据表应该包括列标题，如“产品名称”、“销售额”、“销售量”和“成本”。
在每一列下面，我们将填入相应的数据。
第二步：打开VBA编辑器要编写VBA代码，我们需要打开VBA编辑器。
在Excel中，可以通过按下ALT + F11来打开VBA编辑器。
第三步：创建一个新的模块在VBA编辑器中，我们需要创建一个新的模块来编写我们的代码。
在左侧的“项目资源管理器”窗口中，选择工作簿，然后右键单击并选择“插入”->“模块”。
第四步：编写VBA代码在新的模块中，我们可以开始编写VBA代码。
下面是一个简单的示例代码，用于生成销售数据分析报告：vbaSub CreateSalesReport()Dim wsData As WorksheetDim wsReport As WorksheetDim lastRow As LongDim i As Long' 设置相关工作表Set wsData = ThisWorkbook.Worksheets("数据表")Set wsReport =ThisWorkbook.Worksheets.Add(After:=wsData) = "销售报告"' 标题wsReport.Cells(1, 1) = "产品名称"wsReport.Cells(1, 2) = "销售额"wsReport.Cells(1, 3) = "销售量"wsReport.Cells(1, 4) = "利润率"' 数据lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row ' 获取数据表最后一行For i = 2 To lastRow ' 循环遍历数据表中的数据wsReport.Cells(i, 1) = wsData.Cells(i, 1)wsReport.Cells(i, 2) = wsData.Cells(i, 2)wsReport.Cells(i, 3) = wsData.Cells(i, 3)wsReport.Cells(i, 4).Formula = "=" & wsReport.Cells(i, 2) & "/" & wsReport.Cells(i, 3) ' 计算利润率Next i' 格式化wsReport.Columns("B:B").NumberFormat = "0.00" ' 设置销售额为货币格式wsReport.Columns("C:C").NumberFormat = "0" ' 设置销售量为整数格式wsReport.Columns("D:D").NumberFormat = "0.00" ' 设置利润率为百分比格式' 统计信息wsReport.Cells(lastRow + 2, 1) = "总计"wsReport.Cells(lastRow + 2, 2).Formula = "=SUM(B2:B" & lastRow & ")" ' 计算销售额总计wsReport.Cells(lastRow + 2, 3).Formula = "=SUM(C2:C" & lastRow & ")" ' 计算销售量总计wsReport.Cells(lastRow + 2, 4).Formula = "=AVERAGE(D2:D" & lastRow & ")" ' 计算平均利润率' 增加边框wsReport.Range("A1:D" & lastRow + 2).Borders.LineStyle = xlContinuous' 自动调整列宽wsReport.Columns.AutoFitEnd Sub第五步：执行VBA代码现在，我们可以执行我们编写的VBA代码。
VBA 编程常见实例
1、将excel汇总好的表，按字段拆分为多sheet的情况：如下图：代码如下：Sub cfs()Dim GSArr() As String '公司名称清单Dim Rca As Integer 'A列数据行数Dim i As IntegerDim Sn As StringSn = Rca = Columns("A:A").End(xlDown).Row ‘按第A列数据拆分，且第一行无合并单元格ReDim GSArr(1 To 1)GSArr(1) = Cells(2, 1)For i = 3 To RcaIf IsError(Application.Match(Cells(i, 1), GSArr, 0)) ThenReDim Preserve GSArr(1 To UBound(GSArr) + 1)GSArr(UBound(GSArr)) = Cells(i, 1)End IfNextIf ActiveSheet.AutoFilterMode = False ThenRows("1:1").AutoFilterElseIf ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllDataEnd IfFor i = 1 To UBound(GSArr)ActiveSheet.Cells.AutoFilter Field:=1, Criteria1:=GSArr(i)Sheets.Add After:=Sheets(Sheets.Count) = GSArr(i)Sheets(Sn).Cells.Copy ActiveSheet.CellsSheets(Sn).ActivateNextActiveSheet.Cells.AutoFilterEnd Sub2、将汇总的好的EXCEL表按字段拆分为多个工作薄代码如下：Sub CFGZB()Dim myRange As VariantDim myArrayDim titleRange As RangeDim title As StringDim columnNum As IntegermyRange = Application.InputBox(prompt:="请选择标题行：", Type:=8)myArray = WorksheetFunction.Transpose(myRange)Set titleRange = Application.InputBox(prompt:="请选择拆分的表头，必须是第一行，且为一个单元格，如：“姓名”", Type:=8)title = titleRange.ValuecolumnNum = titleRange.ColumnApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseDim i&, Myr&, Arr, num&Dim d, kFor i = Sheets.Count To 1 Step -1If Sheets(i).Name <> "数据源" Then ‘待拆分的表sheet名为：数据源Sheets(i).DeleteEnd IfNext iSet d = CreateObject("Scripting.Dictionary")Myr = Worksheets("数据源").UsedRange.Rows.CountArr = Worksheets("数据源").Range(Cells(2, columnNum), Cells(Myr, columnNum))For i = 1 To UBound(Arr)d(Arr(i, 1)) = ""Nextk = d.keysFor i = 0 To UBound(k)Set conn = CreateObject("adodb.connection")conn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName‘2013版连接字符Sql = "select * from [数据源$] where " & title & " = '" & k(i) & "'"Dim Nowbook As WorkbookSet Nowbook = Workbooks.AddWith NowbookWith .Sheets(1).Name = k(i)For num = 1 To UBound(myArray).Cells(1, num) = myArray(num, 1)Next num.Range("A2").CopyFromRecordset conn.Execute(Sql)End WithEnd WithThisWorkbook.ActivateSheets(1).Cells.SelectSelection.CopyWorkbooks().ActivateActiveSheet.Cells.SelectSelection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _SkipBlanks:=False, Transpose:=FalseApplication.CutCopyMode = FalseNowbook.SaveAs ThisWorkbook.Path & "\" & k(i)Nowbook.Close TrueSet Nowbook = NothingNext iconn.CloseSet conn = NothingApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueEnd Sub3、将含有多sheet的一个工作表，按sheet名拆分为工作表代码如下：Private Sub 分拆工作表()Dim sht As WorksheetDim MyBook As WorkbookSet MyBook = ActiveWorkbookFor Each sht In MyBook.Sheetssht.CopyActiveWorkbook.SaveAs Filename:=MyBook.Path & "\" & , FileFormat:=xlNormal '将工作簿另存为EXCEL默认格式ActiveWorkbook.CloseNextMsgBox "文件已经被分拆完毕!"End Sub4,、将多个工作薄合并为一个多sheet的工作薄代码如下：Sub Books2Sheets()'定义对话框变量Dim fd As FileDialogSet fd=Application.FileDialog(msoFileDialogFilePicker)'新建一个工作簿Dim newwb As WorkbookSet newwb=Workbooks.AddWith fdIf.Show=-1 Then'定义单个文件变量Dim vrtSelectedItem As Variant'定义循环量Dim i As Integeri=1'开始文件检索For Each vrtSelectedItem In.SelectedItems'打开被合并工作簿Dim tempwb As WorkbookSet tempwb=Workbooks.Open(vrtSelectedItem)'复制工作表tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)'把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsxnewwb.Worksheets(i).Name=VBA.Replace(,".xls","")'关闭被合并工作簿tempwb.Close SaveChanges:=Falsei=i+1Next vrtSelectedItemEnd IfEnd WithSet fd=NothingEnd Sub5、将含有多个sheet的工作表内容信息汇总至一个sheet中Sub Combine()Dim J As IntegerOn Error Resume NextSheets(1).SelectWorksheets.AddSheets(1).Name = "Combined"Sheets(2).ActivateRange("A1").EntireRow.SelectSelection.Copy Destination:=Sheets(1).Range("A1")For J = 2 To Sheets.CountSheets(J).ActivateRange("A1").SelectSelection.CurrentRegion.SelectSelection.Offset(1, 0).Resize(Selection.Rows.Count - 1).SelectSelection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)NextEnd Sub。
VBA程序设计（实例精讲）
VBA程序设计（实例精讲）第2章VBA程序设计2.1⼯作簿和⼯作表⼀、创建和打开⼯作簿Workbooks.Add创建⼀个新的⼯作簿SetNewBook=Workbooks.Add建⼯作簿，⽤对象变量表⽰NewBook.SaveAsFilename:="Test.xls"⼯作簿另存为Workbooks.Open("D:\Test.xls")打开⼯作簿⼆、引⽤⼯作表Worksheets(1).Activate激活第⼀张⼯作表Sheets(4).Activate激活四张⼯作表Worksheets("Sheet1").Activate激活指定的⼯作表Sheets("Chart1").Activate激活图表“Chart1”2.2单元格和区域⼀、引⽤单元格和区域1．⽤A1样式记号引⽤单元格和单元格区域表2.1使⽤Range属性的A1样式引⽤⽰例【例2.6】将⼯作表“Sheet1”中单元格区域A1:D5的字体设置为加粗。
Sheets("Sheet1").Range("A1:D5").Font.Bold=True2.⽤编号引⽤单元格【例2.7】将Sheet1上的单元格A6的Value属性设置为10Worksheets("Sheet1").Cells(6,1).Value=10【例2.9】清除活动⼯作簿中Sheet1上的所有单元格的内容Worksheets("Sheet1").Cells.ClearContents【例2.10】假设⼯作簿中Sheet1的A列是员⼯姓名（不超过50⼈），Sheet2的A列是员⼯姓名、B列是对应的电话号码。
现在需将所有员⼯的电话号码填写到Sheet1中的B列(注：Sheet1中姓名“李三”在Sheet2中可能为“李三”，中间没有空格)。
VBA模块的编程过程(ppt 21页)
中文版Access 2007实用教程
12.5 创建VBA模块
模块是将VBA代码的声明、语句和过程作为一个单元进行保存的集合，是 基本语言的一种数据库对象，数据库中的所有对象都可以在模块中进行引用。 利用模块可以创建自定义函数、子程序以及事件过程等，以便完成复杂的计算 功能。模块可以代替宏，并可以执行标准宏所不能执行的功能。
中文版Access 2007实用教程
12.6.1 设置密码保护Visual Basic代码
用户可以通过对VBA代码设置密码来防止其他非法用户查看或编辑数据 库中的程序代码。
中文版Access 2007实用教程
12.6.2 生成ACCDE文件
除了使用密码保护VBA代码以外，还可以通过创建ACCDE文件保护程序 代码。ACCDE文件是旧版本Access中的.mde 文件的Access 2007版本。
过程是包含VBA代码的基本单位，可以完成一系列指定的操作。过程由 计算的语句和方法组成，通常分为Sub过程、Function过程和Property过程。 其中，Sub过程是最常用的过程类型，也称为命令宏，可以传送参数和使用参 数来调用它，但不返回任何值；Function过程也称为自定义函数过程，其运行 方式和使用程序的内置函数一样，即通过调用Function过程获得函数的返回值； Property过程能够处理对象的属性。
中文版Access 2007实用教程
12.2.1 常量、变量和数组
在VBA中，程序是由过程组成的，过程又由根据VBA规则书写的指令组 成。一个程序包括常量、变量、运算符、语句、函数、数据库对象和事件等基 本要素。
常量 变量 数组
中文版Access 2007实用教程
12.2.2 数据类型
ExcelVBA项目开发案例精选
ExcelVBA项目开发案例精选前言Excel是一款大家极为熟悉、使用极为广泛的电子表格软件。
强大的数据统计，方便的图表制作等功能深受使用者赞誉。
其实Excel的功能远不仅仅如此，在Excel及Office其它软件中还集成了一个开发环境，利用VBA编程进行二次开发，扩充Excel功能，轻松完成复杂而重复的各项操作。
VBA是Excel使用者的福音，是名副其实的Excel的万能工具。
掌握VBA编程会使人们的工作更轻松，更方便。
由于VBA出生于Visual Basic，所以它具有入门容易，应用广泛的特点，还具有开发环境与运行环境无要求，数据库与程序集于一身等优点，经常被用于一些数据管理以及小型系统的开发。
本人是一名教师，在教学实践中开发了许多实用的教学软件。
现精选其中的九款软件编辑成册，奉献给读者。
这些软件既具有一定的实用价值，更重要的是使读者进一步了解VBA的编程方法、开发技巧以及许多算法的实现途径，迅速提高编程水平。
章节安排第1章VBA开发基本技能本章简单介绍了VBA开发人员必须掌握的十大基本技能。
主要有：了解开发环境、熟练宏操作、获取帮助信息、程序调试、熟练掌握基本语法、过程操作、访问Excel各类对象、用户窗体及控件设计、利用FSO 访问文件和文件夹、访问数据库等技术。
第2章中英文输入练习软件键盘输入是每个计算机操作人员的最基本技能。
本软件给用户提供了一个中英文输入的练习环境。
软件根据键盘分布和五笔汉字输入规则，对练习项目合理分类、集中练习、强化记忆、由浅入深、循序渐进组织练习。
软件涉及到的技术主要有：FSO文件系统对象、局域网工作簿的访问、窗体工具栏状态栏的操作、Windows造字程序的使用、图片列表、TreeView、ListView等控件的使用方法。
第3章汉字录入测试系统汉字录入测试在许多场合都有其实用价值。
汉字录入水平高低的测试主要在于速度和准确率的判定。
本软件可以检测录入时间并按照最小错误原则对所录入的文本进行校对，判断出错字、多字以及少字的数量。
100个vba例子程序
100个vba例子程序基本代码这些 VBA 代码将帮助您快速执行一些您经常在电子表格中执行的基本任务1.添加序列号此宏代码将帮助您在Excel 工作表中自动添加序列号，如果您处理大数据，这对您很有帮助。
要使用此代码，您需要选择要从其中开始序列号的单元格，当您运行此代码时，它会显示一个消息框，您需要在其中输入序列号的最高编号，然后单击确定。
一旦您单击“确定”，它就会简单地运行一个循环并将序列号列表添加到向下的单元格中。
2.插入多列此代码可帮助您单击一次输入多个列。
当您运行此代码时，它会询问您要添加的列数，当您单击确定时，它会在所选单元格之后添加输入的列数。
如果要在所选单元格之前添加列，请将代码中的xlToRight 替换为 xlToLeft。
3.插入多行使用此代码，您可以在工作表中输入多行。
运行此代码时，您可以输入要插入的行数，并确保选择要插入新行的单元格。
如果要在所选单元格之前添加行，请将代码中的 xlT oDown 替换为 xlT oUp。
4. 自动调整列此代码可快速自动适应工作表中的所有列。
因此，当您运行此代码时，它将选择工作表中的所有单元格并立即自动调整所有列。
5. 自动调整行您可以使用此代码自动调整工作表中的所有行。
当您运行此代码时，它将选择工作表中的所有单元格并立即自动适应所有行。
6.删除文本换行此代码将帮助您通过单击从整个工作表中删除文本换行。
它将首先选择所有列，然后删除文本换行并自动适应所有行和列。
您还可以使用 (Alt + H +W) 的快捷方式，但如果将此代码添加到快速访问工具栏，它比键盘快捷方式更方便。
7. 取消合并单元格此代码仅使用 HOME 选项卡上的取消合并选项。
使用此代码的好处是您可以将其添加到 QAT 并取消合并选择中的所有单元格。
如果您想取消合并特定范围，您可以通过替换单词选择在代码中定义该范围。
8. 打开计算器在Windows 中，有一个特定的计算器，通过使用此宏代码，您可以直接从 Excel 打开该计算器。
vba小程序实例
vba小程序实例VBA小程序实例VBA（Visual Basic for Applications）是一种用于宏编程的编程语言，常用于Microsoft Office软件中。
通过编写VBA小程序，我们可以实现自动化处理数据、操作软件等功能。
本文将通过几个实例来展示VBA小程序的具体应用。
一、实例一：批量处理Excel表格数据假设我们需要对一个包含大量数据的Excel表格进行处理，例如筛选、排序、求和等操作。
使用VBA小程序可以大大提高工作效率。
我们打开Excel软件，按下“Alt + F11”快捷键，打开VBA编辑器。
然后在工程资源管理器中选择“插入”-“模块”，在新建的模块中编写VBA代码。
代码示例：Sub Data_Processing()' 定义变量Dim ws As WorksheetDim rng As Range' 设置工作表和数据范围Set ws = ThisWorkbook.Worksheets("Sheet1")Set rng = ws.Range("A1:E10")' 进行数据处理rng.AutoFilter Field:=1, Criteria1:=">100" ' 筛选大于100的数据' 其他数据处理操作...End Sub上述代码中，我们首先定义了两个变量ws和rng，分别表示工作表和数据范围。
然后通过设置工作表和数据范围，我们可以对指定范围内的数据进行处理。
例如，上述代码中使用了“AutoFilter”方法对第一列数据进行筛选，只显示大于100的数据。
二、实例二：自动发送邮件在日常工作中，我们经常需要发送邮件给固定的收件人。
使用VBA 小程序，我们可以编写一个自动发送邮件的程序，实现批量发送邮件的功能。
我们同样需要打开VBA编辑器。
然后在工程资源管理器中选择“插入”-“模块”，在新建的模块中编写VBA代码。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
VBA程序教学用例【例1】求解一元二次方程Ax2+Bx+C=0。
顺序结构的VBA程序：SUB JFC1()A = Sheets("解一元二次方程").Cells(1, 2)B = Sheets("解一元二次方程").Cells(2, 2)C = Sheets("解一元二次方程").Cells(3, 2)X1=(-B+SQR(B^2-4*A*C))/2/AX2=(-B-SQR(B^2-4*A*C))/2/ADEBUG.PRINT “X1=”,X1DEBUG.PRINT “X2=”,X2END SUB提示：先将三个系数A、B、C存放到表"解一元二次方程"的单元格B1:B3中，运行结果在立即窗口中（可用CTRL+G组合键打开立即窗口）。
带判断条件的VBA程序：Sub JFC2()A = Sheets("解一元二次方程").Cells(1, 2)B = Sheets("解一元二次方程").Cells(2, 2)C = Sheets("解一元二次方程").Cells(3, 2)If B * B - 4 * A * C >= 0 ThenSheets("解一元二次方程").Cells(4, 2) = (-B + Sqr(B ^ 2 - 4 * A * C)) / 2 / A Sheets("解一元二次方程").Cells(5, 2) = (-B - Sqr(B ^ 2 - 4 * A * C)) / 2 / A ElseSheets("解一元二次方程").Cells(4, 2) = "此方程无实根"Sheets("解一元二次方程").Cells(5, 2) = "此方程无实根"End IfEnd Sub提示：先将三个系数A、B、C存放到表"解一元二次方程"的单元格B1:B3中，运行结果在B4:B5中）。
【例2】给定成绩数据在表sheet2中，求最高分、最低分和平均分。
（1）程序流程总图求N个数平均值的算法流程“打擂法”求最大的算法流程（2）VBA程序Sub CJTJ()X = Sheets("成绩统计").Cells(2, 2)MA = XMI = XP = 0I = 2Do While Sheets("成绩统计").Cells(I, 2) <> ""X = Sheets("成绩统计").Cells(I, 2)P = P + XIf X > MA Then MA = XIf X < MI Then MI = XI = I + 1LoopP = P / (I - 2)Sheets("成绩统计").Cells(I + 1, 1) = "最高分"Sheets("成绩统计").Cells(I + 1, 2) = MASheets("成绩统计").Cells(I + 2, 1) = "最低分"Sheets("成绩统计").Cells(I + 2, 2) = MISheets("成绩统计").Cells(I + 3, 1) = "平均分"Sheets("成绩统计").Cells(I + 3, 2) = PEnd Sub思考题：如果要在CJTJ程序中增加计算标准差功能，程序该如何修改？【例3】打印九九乘法表。
Sub 九九乘法表()Dim i as integer, j as integerFor i=1 to 9For j=1 to 9Sheets(“九九乘法表”).Cells(I,j)= I & ”*” & j & ”=” & i*jNext jNext iEnd sub程序说明：（1）循环嵌套：外循环I循环，内循环J循环；（2）关键语句：Sheets(“九九乘法表”).Cells(I,j)= I & ”*” & j & ”=” & i*j思考题：如何打印主对角线下面的三角形状的九九乘法表？【例4】打印N以内的素数。
（1）流程图(2) 程序代码Public Sub 打印N以内的素数()Dim I As Integer, J As Integer, K As Integer, R As Integer, N As Integer, H As IntegerN = Sheets("SHEET1").Cells(1, 2)R = 3H = 1For I = 2 To NK = 0For J = 1 To IIf I Mod J = 0 ThenK = K + 1End IfNext JIf K = 2 ThenIf H > 15 ThenH = 1R = R + 1End IfSheets("SHEET1").Cells(R, H) = IH = H + 1End IfNext IEnd Sub【例5】问卷统计。
（1）流程图(2) 程序代码Public Sub 问卷统计()Dim I As Integer, N As Integer, J As Integer, X As String, L As Integer, X1 As String, S(9, 4) As IntegerWorksheets("问卷统计1").ActivateI = 2Do While Sheets("问卷统计1").Cells(I, 1) <> ""I = I + 1LoopN = I - 2L = Len(Sheets("问卷统计1").Cells(N, 1))For I = 1 To NX = Sheets("问卷统计1").Cells(I + 1, 1)For J = 1 To LX1 = Mid$(X, J, 1)K = Asc(X1) - 64S(J, K) = S(J, K) + 1Next JNext IFor I = 1 To 4Sheets("问卷统计1").Cells(1, I + 2) = Chr$(I + 64) Next IFor I = 1 To LSheets("问卷统计1").Cells(I + 1, 2) = IFor J = 1 To 4Sheets("问卷统计1").Cells(I + 1, J + 2) = S(I, J)Next JNext IEnd Sub【例6】随机点将。
Private Sub CommandButton1_Click() Dim i As Integer Dim n As IntegerDim xh As IntegerDim xm As String Dim x As LongWorksheets(ComboBox1.Value).Activate *选中表 i = 2Do While Sheets(ComboBox1.Value).Cells(i, 1) <> ""i = i + 1Loop n = i - 2 Randomizexh = Int(n * Rnd) + 1 *随机产生一个序号xm = Sheets(ComboBox1.Value).Cells(xh + 1, 2).Value *取相应姓名 If Sheets(ComboBox1.Value).Cells(xh + 1, 10).Value <> 1 Then TextBox1.Value = xhTextBox2.Value = xmSheets(ComboBox1.Value).Cells(xh + 1, 10).Value = 1End If *如果本次点将已点过则不显示抽到者信息，重新抽取 End Sub【进入VBA 程序】*定义变量*获取总人数*如果本次点将尚未点过则显示抽到者信息【例7】 计算定积分 baxdx sin 。
(0≦a<b ≦π)方法一：梯形法 SUB DJF()A=SHEETS(“定积分计算”).CELLS(3,2) B=SHEETS(“定积分计算”).CELLS(4,2) N=SHEETS(“定积分计算”).CELLS(5,2) S=0FOR I= 1 TO NS=S+(SIN((I-1)/N)+SIN(I/N))/2/N NEXT ISHEETS(“定积分计算”).CELLS(6,2)=S END SUB方法二：蒙特卡洛法Public Sub 蒙托卡洛法计算定积分()Dim N As Single, J As Single, M As Single, A As Single, B As Single N = Sheets("定积分计算").Cells(13, 2) A = Sheets("定积分计算").Cells(11, 2) B = Sheets("定积分计算").Cells(12, 2) M = 0 J = 1Do While J <= N Randomize X = B * Rnd Y = RndIf Y <= Sin(X) Then M = M + 1 J = J + 1 LoopSheets("定积分计算").Cells(14, 2) = M / N * B End Sub【例8】儿童算术练习与测试。
功能要求1. 随机抽题：随机抽取100以内范围的整数加减法题，减法时保证减数不大于被减数；2. 评判正误：当练习者（或被测试）提交答案时，给出评判结果，并自动计算正确率。
抽题VBA程序：Public COUNTN As Integer, COUNTN1 As IntegerSub 抽题()Sheets("儿童算术训练").Cells(8, 2) = "?"RandomizeX = Int(Rnd() * 100)Y = Int(Rnd() * 100)Z = "-"If Rnd() < 0.5 Then Z = "+"If Z = "-" And X < Y ThenT = XX = YY = TEnd IfSheets("儿童算术训练").Cells(8, 3) = XSheets("儿童算术训练").Cells(8, 5) = ZSheets("儿童算术训练").Cells(8, 6) = YSheets("儿童算术训练").Cells(8, 8) = "="Sheets("儿童算术训练").Cells(8, 9) = ""Sheets("儿童算术训练").Cells(17, 3) = "输入答案并按Enter键"Range("I8").SelectEnd Sub评判正误VBA程序：Sub 提交答案()COUNT1 = COUNT1 + 1X = Sheets("儿童算术训练").Cells(8, 3)Z = Sheets("儿童算术训练").Cells(8, 5)Y = Sheets("儿童算术训练").Cells(8, 6)If Evaluate(X & Z & Y) = Sheets("儿童算术训练").Cells(8, 9) Then Sheets("儿童算术训练").Cells(8, 2) = "√"COUNT2 = COUNT2 + 1Sheets("儿童算术训练").Cells(17, 3) = "棒极了，继续努力！" ElseSheets("儿童算术训练").Cells(8, 2) = "×"Sheets("儿童算术训练").Cells(17, 3) = "你真笨，要努力哦！" End IfSheets("儿童算术训练").Cells(12, 10) = COUNT2 / COUNT1End Sub。