VBA程序设计用例：程序流程图及程序代码

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/A

X2=(-B-SQR(B^2-4*A*C))/2/A

DEBUG.PRINT “X1=”,X1

DEBUG.PRINT “X2=”,X2

END 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 Then

Sheets("解一元二次方程").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 Else

Sheets("解一元二次方程").Cells(4, 2) = "此方程无实根"

Sheets("解一元二次方程").Cells(5, 2) = "此方程无实根"

End If

End Sub

提示：先将三个系数A、B、C存放到表"解一元二次方程"的单元格B1:B3中，运行结果在B4:B5中）。

【例2】给定成绩数据在表sheet2中，求最高分、最低分和平均分。（1）程序流程总图

求N个数平均值的算法流程“打擂法”求最大的算法流程

（2）VBA程序

Sub CJTJ()

X = Sheets("成绩统计").Cells(2, 2)

MA = X

MI = X

P = 0

I = 2

Do While Sheets("成绩统计").Cells(I, 2) <> ""

X = Sheets("成绩统计").Cells(I, 2)

P = P + X

If X > MA Then MA = X

If X < MI Then MI = X

I = I + 1

Loop

P = P / (I - 2)

Sheets("成绩统计").Cells(I + 1, 1) = "最高分"

Sheets("成绩统计").Cells(I + 1, 2) = MA

Sheets("成绩统计").Cells(I + 2, 1) = "最低分"

Sheets("成绩统计").Cells(I + 2, 2) = MI

Sheets("成绩统计").Cells(I + 3, 1) = "平均分"

Sheets("成绩统计").Cells(I + 3, 2) = P

End Sub

思考题：如果要在CJTJ程序中增加计算标准差功能，程序该如何修改？

【例3】打印九九乘法表。

Sub 九九乘法表()

Dim i as integer, j as integer

For i=1 to 9

For j=1 to 9

Sheets(“九九乘法表”).Cells(I,j)= I & ”*” & j & ”=” & i*j

Next j

Next i

End 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 Integer

N = Sheets("SHEET1").Cells(1, 2)

R = 3

H = 1

For I = 2 To N

K = 0

For J = 1 To I

If I Mod J = 0 Then

K = K + 1

End If

Next J

If K = 2 Then

If H > 15 Then

H = 1

R = R + 1

End If

Sheets("SHEET1").Cells(R, H) = I

H = H + 1

End If

Next I

End 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 Integer

Worksheets("问卷统计1").Activate

I = 2

Do While Sheets("问卷统计1").Cells(I, 1) <> ""

I = I + 1

Loop

N = I - 2

L = Len(Sheets("问卷统计1").Cells(N, 1))

For I = 1 To N

X = Sheets("问卷统计1").Cells(I + 1, 1)

For J = 1 To L

X1 = Mid$(X, J, 1)

K = Asc(X1) - 64

S(J, K) = S(J, K) + 1

Next J

Next I

For I = 1 To 4

Sheets("问卷统计1").Cells(1, I + 2) = Chr$(I + 64) Next I

For I = 1 To L

Sheets("问卷统计1").Cells(I + 1, 2) = I

For J = 1 To 4

Sheets("问卷统计1").Cells(I + 1, J + 2) = S(I, J)

Next J

Next I

End Sub