VBA编程中的常用代码.docx
《VBA编程中的常用代码.docx》由会员分享，可在线阅读，更多相关《VBA编程中的常用代码.docx（13页珍藏版）》请在冰豆网上搜索。
VBA编程中的常用代码
Excel与VBA编程中的常用代码
用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！
使用Dim语句
Dimaasinteger'声明A为整形变量
Dima'声明A为变体变量
Dimaasstring'声明A为字符串变量
Dima,b,cascurrency'声明A,b,c为货币变量
......
声明变量可以是：
Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String*length（定长字符串）、Object、Variant、用户定义类型或对象类型。
强制声明变量
OptionExplicit
说明：
该语句必在任何过程之前出现在模块中。
--------------------------------------------------------------------------------
声明常数，用来代替文字值。
Const
'常数的默认状态是Private。
ConstMy=456
'声明Public常数。
PublicConstMyString="HELP"
'声明PrivateInteger常数。
PrivateConstMyIntAsInteger=5
'在同一行里声明多个常数。
ConstMyStr="Hello",MyDoubleAsDouble=
--------------------------------------------------------------------------------
在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。
只要将该段代码加入到你的模块中。
SubMy_Select
Endsub
--------------------------------------------------------------------------------
删除当前单元格中数据的前后空格。
submy_trim
Trim
endsub
--------------------------------------------------------------------------------
使单元格位移
submy_offset
（0,1）.Select'当前单元格向左移动一格
（0,-1）.Select'当前单元格向右移动一格
（1,0）.Select'当前单元格向下移动一格
（-1,0）.Select'当前单元格向上移动一格
endsub
如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往
submy_offset之下加一段代码onerrorresumenext
--------------------------------------------------------------------------------
注意以下代码都不再添加sub“代码名称”和endsub请自己添加!
给当前单元格赋值：
="你好！
！
！
"
给特定单元格加入一段代码:
例如：
在Ａ１单元格中插入"ＨＥＬＬＯ"
Range（"a1"）.value="hello"
又如：
你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ"
1.
sheets（"sheet2"）.select
range（"a1"）.value="hello"
或
2.
Sheets（"sheet1"）.Range（"a1"）.Value="hello"
说明：
被打开，然后在将“HELLO"放入到A1单元格中。
不被打开，将“HELLO"放入到A1单元格中。
--------------------------------------------------------------------------------
隐藏工作表
'隐藏SHEET1这张工作表
sheets（"sheet1"）.Visible=False
'显示SHEET1这张工作表
sheets（"sheet1"）.Visible=True
--------------------------------------------------------------------------------
有时候我们想把所有的EXCEL中的SHEET都打印预览，请使用该段代码，它将在你现有的工作簿中循环，直到最后一个工作簿结束循环预览。
DimmyAsWorksheet
ForEachmyInWorksheets
Nextmy
--------------------------------------------------------------------------------
得到当前单元格的地址
msgbox
--------------------------------------------------------------------------------
得到当前日期及时间
msgboxdate&chr（13）&time
--------------------------------------------------------------------------------
保护工作簿
取消保护工作簿
--------------------------------------------------------------------------------
给当前工作簿改名为"liu"
="liu"
--------------------------------------------------------------------------------
打开一个应用程序
AppActivate（Shell（"C:
\WINDOWS\"））
--------------------------------------------------------------------------------
增加一个工作簿
删除当前工作簿
-------------------------------------------------------------------------------
打开一个文件
FileName:
="C:
\MyDocuments\"
关闭当前工作簿
--------------------------------------------------------------------------------
当前单元格定为：
左对齐
=xlLeft
当前单元格定为：
中心对齐
=xlCenter
当前单元格定为：
右对齐
=xlRight
--------------------------------------------------------------------------------
当前单元格为百分号风格
="Percent"
--------------------------------------------------------------------------------
当前单元格字体为粗体
=True
当前单元格字体为斜体
=True
当前单元格字体为宋体20号字
With
.Name="宋体"
.Size=20
EndWith
--------------------------------------------------------------------------------
With语句
With对象
.描述
EndWith
--------------------------------------------------------------------------------
让你的机器发出响声
BEEP
--------------------------------------------------------------------------------
清除单元格中所有文字、批注、格式、所有的东西！
--------------------------------------------------------------------------------
测试选择状态的单元格的行数
MsgBox测试选择状态的单元格的列数
MsgBox
--------------------------------------------------------------------------------
测试选择状态的单元格的地址
--------------------------------------------------------------------------------
让所有的错误不再发生
ONERRORRESUMENEXT
--------------------------------------------------------------------------------
产生错误时让错误转到另一个地方
onerrorgotol
'code
l:
'code
--------------------------------------------------------------------------------
删除一个文件
kill"c:
\"
--------------------------------------------------------------------------------
定制自己的状态栏
="现在时刻:
"&Time
恢复自己的状态栏
=false
--------------------------------------------------------------------------------
在运行期执行一个宏
macro:
="text"
--------------------------------------------------------------------------------
滚动窗口到a1的位置
=1
=1
--------------------------------------------------------------------------------
定制系统日期
DimMyDate,MyDay
MyDate=#12/12/69#
MyDay=Day（MyDate）
--------------------------------------------------------------------------------
今天的年限
DimMyDate,MyYear
MyDate=Date
MyYear=Year（MyDate）
MsgBoxMyYear
--------------------------------------------------------------------------------
产生一个inputbox<输入框>
InputBox（"Enternumberofmonthstoadd"）
--------------------------------------------------------------------------------
得到一个文件名：
DimkkAsString
kk=（"EXCEL（*.XLS）,*.XLS",Title:
="提示：
请打开一个EXCEL文件：
"）
msgboxkk
--------------------------------------------------------------------------------
打开zoom对话框
（xlDialogZoom）.Show
--------------------------------------------------------------------------------
激活字体对话框
（xlDialogActiveCellFont）.Show
--------------------------------------------------------------------------------
打开另存对话框
DimkkAsString
kk=（"excel（*.xls）,*.xls"）
kk
--------------------------------------------------------------------------------
此段代码寻找字符串中特定字符的位置，需要建立一个窗体，并在窗体中，放入TEXTBOX1,TEXTBOX2和TEXTBOX3（3个文本框）及COMMANDBUTTON1（按钮），如下图所示：
PrivateSubCommandButton1_Click（）
a=
b=
aa=Len（a）
i=1
DimYYAsString
Ifb=""ThenExitSub
Do
IfInStr（i,a,b,vbTextCompare）=0ThenExitDo
kk=InStr（i,a,b,vbTextCompare）
YY=YY&CStr（kk）&"/"
i=kk+1
LoopWhileaa>=i
=YY
EndSub
****************
*定制模块行为*
****************
OptionExplicit'强制对模块内所有变量进行声明
OptionPrivateModule'标记模块为私有,仅对同一工程中其它模块有用,在宏对话框中不显示
OptionCompareText'字符串不区分大小写
OptionBase1'指定数组的第一个下标为1
OnErrorResumeNext'忽略错误继续执行VBA代码,避免出现错误消息
OnErrorGoToErrorHandler'当错误发生时跳转到过程中的某个位置
OnErrorGoTo0'恢复正常的错误提示
=False'在程序执行过程中使出现的警告框不显示
=False'关闭屏幕刷新
=True'打开屏幕刷新
'禁用Ctrl+Break中止宏运行的功能
'清除程序运行过程中所有的错误
**********
*工作簿*
**********
（）'创建一个新的工作簿
Workbooks（""）.Activate'激活名为book1的工作簿
'保存工作簿
'关闭当前工作簿
'获取活动工作薄中工作表数
'返回活动工作薄的名称
'返回当前工作簿名称
'返回当前工作簿路径和名称
=False'禁止调整活动工作簿的大小
xlArrangeStyleTiled'将工作簿以平铺方式排列
=xlMaximized'将当前工作簿最大化
（""LastSaveTime"）
或""LastSaveTime"）'返回上次保存工作簿的日期和时间
（"LastPrintDate"）
或""LastPrintDate"）'返回上次打印或预览工作簿的日期和时间
'关闭所有打开的工作簿
（xlExcelLinks）'返回当前工作簿中的第一条链接
'返回工作簿代码的名称
'返回当前工作簿文件格式代码
'返回当前工作簿的路径（注:
若工作簿未保存,则为空）
'返回当前工作簿的读/写值（为False）
'返回工作簿的存储值（若已保存则为False）
=False'隐藏工作簿
=True'显示工作簿
注:
可与用户窗体配合使用,即在打开工作簿时将工作簿隐藏,只显示用户窗体.可设置控制按钮控制工作簿可见
**********
*工作表*
**********
'当前工作表中已使用的行数
'获取工作表的行数（注：
考虑向前兼容性）
Sheets（Sheet1）.Name="Sum"'将Sheet1命名为Sum
Before:
=Worksheets'添加一个新工作表在第一工作表前
After:
=ActiveWorkbook._
Sheets'将当前工作表移至工作表的最后
Worksheets（Array（"sheet1","sheet2"））.Select'同时选择工作表1和工作表2
Sheets（"sheet1"）.Delete或Sheets
（1）.Delete'删除工作表1
（i）.Name'获取工作表i的名称
=Not'切换工作表中的网格线显示,这种方法也可以用在其它方面进行相互切换,即相当于开关按钮
=Not'切换工作表中的行列边框显示
'删除当前工作表中所有的条件格式
'取消当前工作表所有超链接
或'将页面设置更改为横向
'在页面设置的表尾中输入文件路径
'将用户名放置在活动工作表的页脚
（"B"）.Insert'在A列右侧插入列,即插入B列
（"E"）.Cut
（"B"）.Insert'以上两句将E列数据移至B列,原B列及以后的数据相应后移
（"B"）.Cut
（"E"）.Insert'以上两句将B列数据移至D列,原C列和D列数据相应左移一列
'计算当前工作表
（""sheet1"）.Visible=xlSheetHidden'正常隐藏工作表,同在Excel菜单中选择""格式——工作表——隐藏"操作一样
（""sheet1"）.Visible=xlSheetVeryHidden'隐藏工作表,不能通过在Excel菜单中选择""格式——工作表——取消隐藏"来重新显示工作表
（""sheet1"）.Visible=xlSheetVisible'显示被隐藏的工作表
（1）.ProtectContents'检查工作表是否受到保护
Count:
=2,Before:
=
（2）
或
（2）,,2'在第二个工作表之前添加两个新的工作表
（3）.Copy'复制一个工作表到新的工作簿
（3）.Copy'复制第三个工作表到第二个工作表之前
=20'改变工作表的列宽为20
='将工作表的列宽恢复为标准值
=20'改变工作表列1的宽度为20
=10'改变工作表的行高为10
='将工作表的行高恢复为标准值
=10'改变工作表的行1的高度值设置为10
（1）.Activate'当前工作簿中的第一个工作表被激活
（"Sheet1"）.Rows
（1）.=True'设置工作表Sheet1中的行1数据为粗体
（"Sheet1"）.Rows
（1）.Hidden=True'将工作表Sheet1中的行1隐藏
=True'将当前工作表中活动单元格所在的行隐藏
注：
同样可用于列。
（""A:
A"）.'自动调整当前工作表A列列宽
'选中当前工作表中常量和文本单元格
'选中当前工作表中常量和文本及错误值单元格
**********************
*单元格/单元格区域*
**********************
或Range（xlUp）,（xlDown））.Select'选择当前活动单元格所包含的范围,上下左右无空行
'选定当前工作表的所有单元格
Range（"A1"）.ClearContents'清除活动工作表上单元格A1中的内容
'清除选定区域内容
Range（"A1:
D4"）.Clear'彻底清除A1至D4单元格区域的内容,包括格式
'清除工作表中所有单元格的内容
（1,0）.Select'活动单元格下移一行,同理,可下移一列
Range（"A1"）.Offset（ColumnOffset:
=1）或Range（"A1"）.Offset'偏移一列
Range（"A1"）.Offset（Rowoffset:
=-1）或Range（"A1"）.Offset'向上偏移一行
Range（"A1"）.CopyRange（"B1"）'复制单元格A1,粘贴到单元格B1中
Range（"A1:
D8"）.CopyRange（"F1"）'将单元格区域复制到单元格F1开始的区域中
Range（"A1:
D8"）.CutRange（"F1"）'剪切单元格区域A1至D8,复制到单元格F1开始的区域中
Range（"A1"）.Sheets（"Sheet2"）.Range（"A1"）'复制包含A1的单元格区域到工作表2中以A1起始的单元格区域中
注：
CurrentRegion属性等价于定位命令,由一个矩形单元格块组成,周围是一个或多个空行或列
'将值XX输入到所选单元格区域中
'活动窗口中选择的单元格数
'当前选中区域的单元格数
GetAddress=Replace
（1）.Address,mailto:
""）'返回单元格中超级链接的地址并赋值
TextColor=Range（"A1"）.'检查单元格A1的文本颜色并返回颜色索引
Range（"A1"）.'获取单元格A1背景色
'返回当前工作表的单元格数
（"E4"）.Select'激活当前活动单元格下方3行,向右4列的单元格
（5,"C"）'引单元格C5
'引单元格C5
Range（"A1"）.Offset（RowOffset:
=4,ColumnOffset:
=5）
或Range（"A1"）.Offset'指定单元格F5
Range（"B3"）.Resize（RowSize:
=11,ColumnSize:
=3）
Rnage（"B3"）.Resize（11,3）'创建B3：
D13区域
Range（"Data"）.Resize'将Data区域扩充2列
Union（Range（"Data1"）,Range（"Data2"））'将Data1和Data2区域连接
Intersect（Range（"Data1"）,Range（"Data2"））'返回Data1
升级会员 