VBA编程实例Word下载.docx
《VBA编程实例Word下载.docx》由会员分享,可在线阅读,更多相关《VBA编程实例Word下载.docx(35页珍藏版)》请在冰豆网上搜索。
Nexti
利用Move方法以及Sheets(i)移动工作表,按指定的顺序排列
Fori=1ToWsCount
Worksheets(WsArray(i)).Movebefore:
=Sheets(i)Nexti
EndSub
第七章批注
1、Comment为Range对象的属性
2、Comments返回指定工作表中所有的批注,可以利用Foreach对工作表中所有批注循环题目:
(1)根据批注的作者,删除批注
(2)隐藏工作表中所有批注
(3)为区域中添加批注
(4)测试Comments(index)返回指定工作表中第index个批注
Sub统计批注个数()
DimFlagAsComment
1、Comments返回指定工作表中所有的批注
2、用Comment属性返回一个Comment对象
ForEachFlagInActiveSheet.Comments
NextFlag
MsgBox"
活动工作表中共有:
"
&
t&
个批注"
vbOKOnly,"
统计批注个数"
EndSub
SubCountComment()
DimFlagAsRange
利用err来判断是否发生错误
ForEachFlagInActiveSheet.UsedRange
t=Flag.Comment.Text
IfErr=0Thenk=k+1NextFlag
k&
Sub选定批注单元格()
Dima()AsRange
ReDima(ActiveSheet.Comments.Count)Fori=1ToActiveSheet.Comments.Count
Seta(i-1)=ActiveSheet.Comments(i).Parent
SetFlag=a
Flag.Select
Subselectcomment()
使用编辑定位功能,定位批注,选定单元格
Cells.SpecialCells(xlCellTypeComments).Select
Sub显示或隐藏批注()
IfFlag.Visible=TrueThen
Flag.Visible=False
Else
Flag.Visible=True
SubDisHideComment()
利用application的displaycommentindicator属性来显示隐藏批注
Indicator表示批注的标识符
IfApplication.DisplayCommentIndicator=xlCommentAndIndicatorThen
Application.DisplayCommentIndicator=xlCommentIndicatorOnly
Application.DisplayCommentIndicator=xlCommentAndIndicator
Sub输出所有批注()
在Sheet2工作表中返回Sheet1工作表中所有批注
这里使用ment.text返回批注中的内容
DimtAsInteger
i=1
WithWorksheets("
Sheet2"
)
.Cells.Clear
.Cells(1,1)="
第n个批注"
.Cells(1,2)="
批注地址"
.Cells(1,3)="
批注内容"
ForEachFlagInWorksheets("
Sheet1"
).Comments
i=i+1
.Cells(i,1)=t
.Cells(i,2)=Flag.Parent.Address
.Cells(i,3)=Flag.Parent.Comment.Text
.Columns("
B:
B"
).EntireColumn.AutoFit
C:
C"
).ColumnWidth=34
.Cells.EntireRow.AutoFit
EndWith
Sub改变批注颜色()
Flag.Shape.Fill.ForeColor.SchemeColor=Int((80)*Rnd+1)'
1-80
Flag.Shape.TextFrame.Characters.Font.ColorIndex=Int((56)*Rnd+1)'
1-56
Sub添加批注()
ForEachFlagInActiveSheet.Range("
g8:
i17"
Flag.AddComment.Text"
hner:
这是我添加的第"
Chr(13)+Chr(10)&
Date
Subtest()
MsgBoxActiveSheet.Range("
g8"
).Comment.Author
Sub删除批注()
Flag.Comment.Delete
第十章自定义函数
函数一:
计算销售佣金
题1:
根据销售额和对应的佣金率计算=Sales*Rate题2:
根据销售额和对应的佣金率以及工作年限计算,工作每满一年佣金在原来的基础上增加一个百分点
=Sales*Rate*(1+Year/100)
条件临界点佣金率
[0,10000)00.08
[10000,20000)100000.105
[20000,40000)200000.12
[40000,无穷)400000.14
计算方法:
1、利用vlookup函数的模糊查找:
=VLOOKUP(B2,$B$14:
$C$17,2,TRUE)*B2定期维护佣金率
2、利用if函数结合&
连接符突破if七层嵌套问题:
=IF(AND(B2>
=0,B2<
$B$15),B2*$C$14,"
&
IF(AND(B2>
=$B$15,B2<
$B$16),B2*$C$15,"
)&
=$B$16,B2<
$B$17),B2*$C$16,"
=
$B$17),B2*$C$17,"
3、利用自定义函数,代码如下:
FunctionCommission1(Sales,years)'
计算销售佣金,工作每满一年,销售佣金在原来的基础上增加一个百分点ConstRate1=0.08
ConstRate2=0.105
ConstRate3=0.12
ConstRate4=0.14
SelectCaseSales
Case0To9999.99'
Caseatob表示[a,b]两边都是闭区间
Commission1=Sales*Rate1
Case10000To19999.99
Commission1=Sales*Rate2
Case20000To39999.99
Commission1=Sales*Rate3
CaseElse
Commission1=Sales*Rate4EndSelect
每工作满一年,佣金在原来的基础上增加1个百分点
Commission1=Commission1*(1+years/100)
EndFunction
Sub计算销售佣金()
’在工作表中设计一个窗体按钮,执行此代码
DimSales
DimyearsAsInteger
Sales=Val(InputBox("
请输入销售额:
"
计算销售佣金"
))
years=Val(InputBox("
请输入工作年限:
y=MsgBox("
您的佣金为:
Commission1(Sales,years),vbYesNo,"
)Ify=vbYesThen'
这里使用msgbox信息框,当单击是的时候,调用该过程本身计算销售佣金EndIf
函数二:
随机抽取某区域中的一个单元格
目的:
理解Optional定义变量和非易失性函数Volatile
1、易失性函数:
顾名思义该函数很容易改变,也就是无论何时在工作表任意单元格输入数据,易失性函数都需要重新计算,结合本例,只要在任意单元格输入数据,易失性函数都重新计算2、非易失性函数:
顾名思义该函数不容易改变,也就是只有在函数中的参数值发生变化时,非易失性函数才重新计算,否则不计算,结合本例,只有在a1:
a10输入数据,非易失性函数才重新计算,否则不计算3、Optional申明变量,表示该变量为可选参数
4、假如Region为一个range对象区域,那么Region(i)表示区域Region中第i个对象
代码如下:
FunctionUnderstandVolatile(RegionAsRange,OptionalFlagBooleanAsBoolean=False)
利用optional定义变量表示该变量为可选参数
理解非易失性函数
函数功能:
随机抽取Region区域中的一个单元格值
当application.volatiletrue时,表示易失性函数
Application.VolatileFlagBoolean
产生[a,b]之间的随机整数Int(rnd()*(b-a+1)+1)
UnderstandVolatile=Region(Int(Rnd()*(Region.Count)+1))
函数三:
利用Optional来确定自定义函数是一个多单元格数组函数还是一个普通函数MonthNames(Optional
Mindex)
返回月份
可选参数:
1、当无参数时,返回一个多单元格数组公式,横向数组,将一个数组直接赋值给自定义函数2、当参数大于等于1时,返回对应月份,如参数为1,则返回Jan,参数为13,也同样返回Jan3、当参数小于等于0时,返回一个多单元格数组公式,垂直数组
FunctionMonthNames(OptionalMindex)'
Ismissing(t)表示t是否传递给过程,如果没有传递,则返回true
DimAllNamesAsVariant
AllNames=Array("
Jan"
Feb"
Mar"
Apr"
May"
Jun"
Jul"
Aug"
Sep"
Oct"
Nov"
Dec"
IfIsMissing(Mindex)Then
MonthNames=AllNames
SelectCaseMindex
CaseIs>
=1
如果参数为1,则返回Jan,为数组的第一个元素,故应该用(Mindex-1mod12),数组的下限为0,即AllNames(0)
MonthNames=AllNames((Mindex-1)Mod12)
MonthNames=Application.WorksheetFunction.Transpose(AllNames)
EndSelect
这里使用一个ismissing函数,该函数主要是用来测试是否将参数传递给过程,如果没有传递,则返回TRUE。
如:
在工作表中输入=MonthNames()此时并没有传递参数给过程
函数四:
颠倒字符串
运用vba函数和如何操作字符串
vba函数:
1、StrReverse(String)返回反向字符串,当string为空值时,则函数返回空字符窜,如果无参数,则返回null2、MID(String,i,n)从字符串string的第i个位置开始提取长度为n的字符串
函数使用fori=len(string)to1step-1
n=mid(string,i,1)
遍历字符串中的每个字符,此方法可以运用到数字与字符分离或者字符串中各数字求和等
nexti
FunctionMstrReverse(Mstring)AsString'
利用vba函数StrReverse返回反向字符串
MstrReverse=VBA.StrReverse(Mstring)EndFunction
FunctionMstrreverse1(Mstring)AsStringDimiAsInteger
Fori=Len(Mstring)To1Step-1
Mstrreverse1=Mstrreverse1&
Mid(Mstring,i,1)Nexti
SubMstrreverse2()
Mstring=InputBox("
请输入字符串:
反向字符串"
IfMstring="
ThenExitSub
字符串:
Mstring&
的反向字符串为:
vbCrLf&
MstrReverse(Mstring),vbOKOnly,"
小窍门:
在实际输入vba代码时,可能没有熟记vba常量或者vba函数,此时可以在vbe中按ctrl+j返回常数列表,供选择。
或者输入vba.则返回vba函数供选择。
函数五:
字符串全部大写或者全部小写AlUcLcase(Mstring,OptionalMbooleanAsBoolean=True)
算法:
、遍历字符串中的每个字符1
2、对字符串中的每个字符进行判断
条件一:
如果函数的第二个参数省略或者第二个参数为TRUE时,表示要将字符串全部大写、如果ASC(字符)在[97,122],那么,表示该字母为小写字母需要转换。
转换字符=CHR(ASC(字符)-32)1
2、如果不满足上述条件,表示字母表示大写字母或者非字母,此时不需要转换,只需字符连接条件二:
如果函数的第二个参数为False时,表示要将字符串全部小写
1、如果ASC(字符)在[65,90],那么,表示该字母为大写字母需要转换。
转换字符=CHR(ASC(字符)+32)2、如果不满足上述条件,表示字母表示小写字母或者非字母,此时不需要转换,只需字符连接
vba函数
1、ASC(字符)表示返回字符的ASICC码,相当于EXCEL工作表中的CODE函数
2、CHR(数字)表示返回数字对应的字符,相当于EXCEL工作表中的CHAR函数
3、UCASE(字符)表示将字符全部大写,相当于EXCEL工作表中的UPPER函数
、LCASE(字符)表示将字符全部小写,相当于EXCEL工作表中的LOWER函数4
FunctionAlUcLcase(Mstring,OptionalMbooleanAsBoolean=True)AsString
字符串大小写转换,如果省略第二个参数,则将字符串全部大写显示,否则小写显示DimiAsInteger
DimMlenAsInteger
DimSngStringAsString
DimMcodeAsInteger
DimAimStringAsString
Mlen=Len(Mstring)
Fori=1ToMlen
SngString=VBA.Mid$(Mstring,i,1)
Mcode=VBA.Asc(SngString)
注意下面的条件,Ismissing表示当参数省略时,或者当参数为True时,表示将字符串全部大写
IfIsMissing(Mboolean)OrMboolean=TrueThen
IfMcode>
=97AndMcode<
=122Then
AimString=AimString&
VBA.Chr(Mcode-32)
SngString
=65AndMcode<
=90Then
VBA.Chr(Mcode+32)
AlUcLcase=AimString
FunctionAlUcLcase1(Mstring,OptionalMbooleanAsBoolean=True)AsString
字符串大小写转换,如果省略第二个参数,则将字符串全部大写显示,否则小写显示IfIsMissing(Mboolean)OrMboolean=TrueThen
AlUcLcase1=VBA.UCase$(Mstring)Else
AlUcLcase1=VBA.LCase$(Mstring)
Excel2003高级VBA编程---第11章VBA编程示例和技巧
实例一:
利用EXCEL的FileSearch属性批处理查找文件
下面实例主要论证以下几个问题:
1、Application的FileSearch属性,该属性返回一个FoundFiles对象,也就是根据指定的条件,查找出来的满
足条件的文件集合,可以利用Foreach对该集合进行循环。
要查找D盘根目录下,所有TXT文件
下面的代码返回一个FoundFiles属性
WithApplication.FileSearch
.LookIn="
c:
\"
.FileName="
*.txt"
.Execute
对上述属性进行操作
i=1
foreachfsin.FoundFiles
withactivesheet
.cells(1,1)="
序号"
.cells(1,2)="
路径"
i=i+1
.cells(I,1)=I
.cells(I,2)=fs
endwith
nextfs
2、利用工作簿的opentext方法,将文本文件导入到工作表中
3、过程调用,如果某些过程比较通用,最好使用该方法,以提高代码编写效率
具体实例:
SubFileProcess()
文件批处理,将某文件夹下所有文本文件导入到excel工作簿中DimFileFindAsFileSearch
DimfsAsVariant
DimFilePathAsString
DimFileStyleAsString
FilePath=ThisWorkbook.Path&
FileStyle="
.LookIn=FilePath
.Filename=FileStyle
If.FoundFiles.Count=0Then
没有找