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

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

《VBA程序设计用例程序流程图及程序代码.docx》由会员分享，可在线阅读，更多相关《VBA程序设计用例程序流程图及程序代码.docx（16页珍藏版）》请在冰点文库上搜索。

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

VBA程序教学用例

【例1】求解一元二次方程Ax

+Bx+C=0。

顺序结构的VBA程序：

SUBJFC1（）

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

ENDSUB

提示：

先将三个系数A、B、C存放到表"解一元二次方程"的单元格B1:

B3中，运行结果在立即窗口中（可用CTRL+G组合键打开立即窗口）。

带判断条件的VBA程序：

SubJFC2（）

A=Sheets（"解一元二次方程"）.Cells（1,2）

B=Sheets（"解一元二次方程"）.Cells（2,2）

C=Sheets（"解一元二次方程"）.Cells（3,2）

IfB*B-4*A*C>=0Then

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）="此方程无实根"

EndIf

EndSub

提示：

先将三个系数A、B、C存放到表"解一元二次方程"的单元格B1:

B3中，运行结果在B4:

B5中）。

【例2】给定成绩数据在表sheet2中，求最高分、最低分和平均分。

（1）程序流程总图

（2）VBA程序

SubCJTJ（）

X=Sheets（"成绩统计"）.Cells（2,2）

MA=X

MI=X

P=0

I=2

DoWhileSheets（"成绩统计"）.Cells（I,2）<>""

X=Sheets（"成绩统计"）.Cells（I,2）

P=P+X

IfX>MAThenMA=X

IfX

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

EndSub

思考题：

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

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

Sub九九乘法表（）

Dimiasinteger,jasinteger

Fori=1to9

Forj=1to9

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

Nextj

Nexti

Endsub

程序说明：

（1）循环嵌套：

外循环I循环，内循环J循环；

（2）关键语句：

Sheets（“九九乘法表”）.Cells（I,j）

=I&”*”&j&”=”&i*j

思考题：

如何打印主对角线下面的三角形状的九九乘法表？

【例4】打印N以内的素数。

（1）流程图

（2）程序代码

PublicSub打印N以内的素数（）

DimIAsInteger,JAsInteger,KAsInteger,RAsInteger,NAsInteger,HAsInteger

N=Sheets（"SHEET1"）.Cells（1,2）

R=3

H=1

ForI=2ToN

K=0

ForJ=1ToI

IfIModJ=0Then

K=K+1

EndIf

NextJ

IfK=2Then

IfH>15Then

H=1

R=R+1

EndIf

Sheets（"SHEET1"）.Cells（R,H）=I

H=H+1

EndIf

NextI

EndSub

【例5】问卷统计。

（1）流程图

（2）程序代码

PublicSub问卷统计（）

DimIAsInteger,NAsInteger,JAsInteger,XAsString,LAsInteger,X1AsString,S（9,4）AsInteger

Worksheets（"问卷统计1"）.Activate

I=2

DoWhileSheets（"问卷统计1"）.Cells（I,1）<>""

I=I+1

Loop

N=I-2

L=Len（Sheets（"问卷统计1"）.Cells（N,1））

ForI=1ToN

X=Sheets（"问卷统计1"）.Cells（I+1,1）

ForJ=1ToL

X1=Mid$（X,J,1）

K=Asc（X1）-64

S（J,K）=S（J,K）+1

NextJ

NextI

ForI=1To4

Sheets（"问卷统计1"）.Cells（1,I+2）=Chr$（I+64）

NextI

ForI=1ToL

Sheets（"问卷统计1"）.Cells（I+1,2）=I

ForJ=1To4

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

NextJ

NextI

EndSub

【例6】随机点将。

PrivateSubCommandButton1_Click（）

DimiAsInteger

*定义变量

DimnAsInteger

DimxhAsInteger

DimxmAsString

DimxAsLong

Worksheets（ComboBox1.Value）.Activate*选中表

i=2

*获取总人数

DoWhileSheets（ComboBox1.Value）.Cells（i,1）<>""

i=i+1

Loop

n=i-2

Randomize

xh=Int（n*Rnd）+1*随机产生一个序号

xm=Sheets（ComboBox1.Value）.Cells（xh+1,2）.Value*取相应姓名

IfSheets（ComboBox1.Value）.Cells（xh+1,10）.Value<>1Then

*如果本次点将尚未点过则显示抽到者信息

TextBox1.Value=xh

TextBox2.Value=xm

Sheets（ComboBox1.Value）.Cells（xh+1,10）.Value=1

EndIf*如果本次点将已点过则不显示抽到者信息，重新抽取

EndSub

【进入VBA程序】

【例7】计算定积分

。

（0≦a

方法一：

梯形法

SUBDJF（）

A=SHEETS（“定积分计算”）.CELLS（3,2）

B=SHEETS（“定积分计算”）.CELLS（4,2）

N=SHEETS（“定积分计算”）.CELLS（5,2）

S=0

FORI=1TON

S=S+（SIN（（I-1）/N）+SIN（I/N））/2/N

NEXTI

SHEETS（“定积分计算”）.CELLS（6,2）=S

ENDSUB

方法二：

蒙特卡洛法

PublicSub蒙托卡洛法计算定积分（）

DimNAsSingle,JAsSingle,MAsSingle,AAsSingle,BAsSingle

N=Sheets（"定积分计算"）.Cells（13,2）

A=Sheets（"定积分计算"）.Cells（11,2）

B=Sheets（"定积分计算"）.Cells（12,2）

M=0

J=1

DoWhileJ<=N

Randomize

X=B*Rnd

Y=Rnd

IfY<=Sin（X）ThenM=M+1

J=J+1

Loop

Sheets（"定积分计算"）.Cells（14,2）=M/N*B

EndSub

【例8】儿童算术练习与测试。

功能要求

1.随机抽题：

随机抽取100以内范围的整数加减法题，减法时保证减数不大于被减数；

2.评判正误：

当练习者（或被测试）提交答案时，给出评判结果，并自动计算正确率。

抽题VBA程序：

PublicCOUNTNAsInteger,COUNTN1AsInteger

Sub抽题（）

Sheets（"儿童算术训练"）.Cells（8,2）="?

"

Randomize

X=Int（Rnd（）*100）

Y=Int（Rnd（）*100）

Z="-"

IfRnd（）<0.5ThenZ="+"

IfZ="-"AndX

T=X

X=Y

Y=T

EndIf

Sheets（"儿童算术训练"）.Cells（8,3）=X

Sheets（"儿童算术训练"）.Cells（8,5）=Z

Sheets（"儿童算术训练"）.Cells（8,6）=Y

Sheets（"儿童算术训练"）.Cells（8,8）="="

Sheets（"儿童算术训练"）.Cells（8,9）=""

Sheets（"儿童算术训练"）.Cells（17,3）="输入答案并按Enter键"

Range（"I8"）.Select

EndSub

评判正误VBA程序：

Sub提交答案（）

COUNT1=COUNT1+1

X=Sheets（"儿童算术训练"）.Cells（8,3）

Z=Sheets（"儿童算术训练"）.Cells（8,5）

Y=Sheets（"儿童算术训练"）.Cells（8,6）

IfEvaluate（X&Z&Y）=Sheets（"儿童算术训练"）.Cells（8,9）Then

Sheets（"儿童算术训练"）.Cells（8,2）="√"

COUNT2=COUNT2+1

Sheets（"儿童算术训练"）.Cells（17,3）="棒极了，继续努力！

"

Else

Sheets（"儿童算术训练"）.Cells（8,2）="×"

Sheets（"儿童算术训练"）.Cells（17,3）="你真笨，要努力哦！

"

EndIf

Sheets（"儿童算术训练"）.Cells（12,10）=COUNT2/COUNT1

EndSub