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。