VBA编程中的常用代码(1)

Excel与VBA编程中的常用代码

用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！

使用Dim语句

Dim a as integer '声明A为整形变量

Dim a '声明A为变体变量

Dim a as string '声明A为字符串变量

Dim a,b,c as currency '声明A,b,c为货币变量

......

声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String * length（定长字符串）、Object、Variant、用户定义类型或对象类型。

强制声明变量

Option Explicit

说明：该语句必在任何过程之前出现在模块中。

--------------------------------------------------------------------------------

声明常数，用来代替文字值。

Const

' 常数的默认状态是 Private。

Const My = 456

' 声明 Public 常数。

Public Const MyString = "HELP"

' 声明 Private Integer 常数。

Private Const MyInt As Integer = 5

' 在同一行里声明多个常数。

Const MyStr = "Hello", MyDouble As Double = 3.4567

--------------------------------------------------------------------------------

在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。

Sub My_Select

End sub

--------------------------------------------------------------------------------

删除当前单元格中数据的前后空格。

sub my_trim

Trim()

end sub

--------------------------------------------------------------------------------

使单元格位移

sub my_offset

(0, 1).Select'当前单元格向左移动一格

(0, -1).Select'当前单元格向右移动一格

(1 , 0).Select'当前单元格向下移动一格

(-1 , 0).Select'当前单元格向上移动一格

end sub

如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往

sub my_offset 之下加一段代码 on error resume next

--------------------------------------------------------------------------------

注意以下代码都不再添加 sub “代码名称” 和end sub请自己添加!

给当前单元格赋值：

= "你好"

给特定单元格加入一段代码:

例如：在Ａ１单元格中插入"ＨＥＬＬＯ"

Range("a1").value="hello"

又如：你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ"

1.

sheets("sheet2").select

range("a1").value="hello"

或

2.

Sheets("sheet1").Range("a1").Value = "hello"

说明：

2被打开，然后在将“HELLO"放入到A1单元格中。

2不被打开，将“HELLO"放入到A1单元格中。

--------------------------------------------------------------------------------

隐藏工作表

'隐藏SHEET1这张工作表

sheets("sheet1").Visible=False

'显示SHEET1这张工作表

sheets("sheet1").Visible=True

--------------------------------------------------------------------------------

有时候我们想把所有的EXCEL中的SHEET都打印预览，请使用该段代码，它将在你现有的工作簿中循环，直到最后一个工作簿结束循环预览。

Dim my As Worksheet

For Each my In Worksheets

review

Next my

--------------------------------------------------------------------------------

得到当前单元格的地址

msgbox s

--------------------------------------------------------------------------------

得到当前日期及时间

msgbox date & chr(13) & time

--------------------------------------------------------------------------------

保护工作簿

t

取消保护工作簿

ect

--------------------------------------------------------------------------------

给当前工作簿改名为 "liu"

= "liu"

--------------------------------------------------------------------------------

打开一个应用程序

AppActivate (Shell("C:"))

--------------------------------------------------------------------------------

增加一个工作簿

删除当前工作簿

-------------------------------------------------------------------------------

打开一个文件

FileName:="C:My "

关闭当前工作簿

--------------------------------------------------------------------------------

当前单元格定为：左对齐

ntalAlignment = xlLeft

当前单元格定为：中心对齐

ntalAlignment = xlCenter

当前单元格定为：右对齐

ntalAlignment = xlRight

--------------------------------------------------------------------------------

当前单元格为百分号风格

= "Percent"

--------------------------------------------------------------------------------

当前单元格字体为粗体

= True

当前单元格字体为斜体

= True

当前单元格字体为宋体20号字

With

.Name = "宋体"

.Size = 20

End With

--------------------------------------------------------------------------------

With 语句

With 对象

.描述

End With

--------------------------------------------------------------------------------

让你的机器发出响声

BEEP

--------------------------------------------------------------------------------

清除单元格中所有文字、批注、格式、所有的东西！

--------------------------------------------------------------------------------

测试选择状态的单元格的行数

MsgBox

测试选择状态的单元格的列数

MsgBox

--------------------------------------------------------------------------------

测试选择状态的单元格的地址

s

--------------------------------------------------------------------------------

让所有的错误不再发生

ON ERROR RESUME NEXT

--------------------------------------------------------------------------------

产生错误时让错误转到另一个地方

on error goto l

'code

l:

'code

--------------------------------------------------------------------------------

删除一个文件

kill "c:"

--------------------------------------------------------------------------------

定制自己的状态栏

Bar = "现在时刻: " & Time

恢复自己的状态栏

Bar = false

--------------------------------------------------------------------------------

在运行期执行一个宏

macro:="text"

--------------------------------------------------------------------------------

滚动窗口到a1的位置

Row = 1

Column = 1

--------------------------------------------------------------------------------

定制系统日期

Dim MyDate, MyDay

MyDate = #12/12/69#

MyDay = Day(MyDate)

--------------------------------------------------------------------------------

今天的年限

Dim MyDate, MyYear

MyDate = Date

MyYear = Year(MyDate)

MsgBox MyYear

--------------------------------------------------------------------------------

产生一个inputbox<输入框>

InputBox ("Enter number of months to add")

--------------------------------------------------------------------------------

得到一个文件名：

Dim kk As String

kk = nFilename("EXCEL (*.XLS), *.XLS", Title:="提示：请打开一个EXCEL文件：")

msgbox kk

--------------------------------------------------------------------------------

打开zoom对话框

s(xlDialogZoom).Show

--------------------------------------------------------------------------------

激活字体对话框

s(xlDialogActiveCellFont).Show

--------------------------------------------------------------------------------

打开另存对话框

Dim kk As String

kk = eAsFilename("excel (*.xls), *.xls")

kk

--------------------------------------------------------------------------------

此段代码寻找字符串中特定字符的位置，需要建立一个窗体，并在窗体中，放入TEXTBOX1,TEXTBOX2和TEXTBOX3(3个文本框）及COMMANDBUTTON1(按

钮)，如下图所示：

Private Sub CommandButton1_Click()

a =

b =

aa = Len(a)

i = 1

Dim YY As String

If b = "" Then Exit Sub

Do

If InStr(i, a, b, vbTextCompare) = 0 Then Exit Do

kk = InStr(i, a, b, vbTextCompare)

YY = YY & CStr(kk) & "/"

i = kk + 1

Loop While aa >= i

= YY

End Sub

****************

* 定制模块行为 *

****************

Option Explicit '强制对模块内所有变量进行声明

Option Private Module '标记模块为私有,仅对同一工程中其它模块有用,在宏对话框中不显示

Option Compare Text '字符串不区分大小写

Option Base 1 '指定数组的第一个下标为 1

On Error Resume Next '忽略错误继续执行 VBA代码,避免出现错误消息

On Error GoTo ErrorHandler '当错误发生时跳转到过程中的某个位置

On Error GoTo 0 '恢复正常的错误提示

yAlerts=False '在程序执行过程中使出现的警告框不显示

Updating=False '关闭屏幕刷新

Updating=True '打开屏幕刷新

Key=xlDisabled '禁用 Ctrl+Break 中止宏运行的功能

'清除程序运行过程中所有的错误

**********

* 工作簿 *

**********

() '创建一个新的工作簿

Workbooks("").Activate '激活名为 book1的工作簿

'保存工作簿

'关闭当前工作簿

'获取活动工作薄中工作表数

'返回活动工作薄的名称

'返回当前工作簿名称

me '返回当前工作簿路径和名称

Resize=False '禁止调整活动工作簿的大小

e xlArrangeStyleTiled '将工作簿以平铺方式排列

State=xlMaximized '将当前工作簿最大化

nDocumentProperties(""Last Save Time")

或 nDocumentProperties(""Last

Save Time") '返回上次保存工作簿的日期和时间

nDocumentProperties("Last Print Date")

或 nDocumentProperties(""Last

Print Date") '返回上次打印或预览工作簿的日期和时间

'关闭所有打开的工作簿

urces(xlExcelLinks)'返回当前工作簿中的第一条链接

me

me '返回工作簿代码的名称

rmat

rmat '返回当前工作簿文件格式代码

'返回当前工作簿的路径(注:若工作簿未保存,则为空)

ly

ly '返回当前工作簿的读/写值(为 False)

'返回工作簿的存储值(若已保存则为 False)

e = False '隐藏工作簿

e = 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的名称

yGridlines=Not yGridlines '切换

工作表中的网格线显示,这种方法也可以用在其它方面进行相互切换,即相当于开关按钮

yHeadings=Not yHeadings '切换工作表中的行列边框显示

'删除当前工作表中所有的条件格式

'取消当前工作表所有超链接

ation=xlLandscape

或 ation=2 '将页面设置更改为横向

ooter=me '在页面设置的表尾中输入文件路径

oter=me '将用户名放置在活动工作表的页脚

s("B").Insert '在A 列右侧插入列,即插入 B 列

s("E").Cut

s("B").Insert '以上两句将 E 列数据移至 B 列,原 B 列及以后的数据相应后移

s("B").Cut

s("E").Insert '以上两句将 B列数据移至 D列,原 C列和

D列数据相应左移一列

ate '计算当前工作表

eets(""sheet1").Visible=xlSheetHidden '正常隐藏工作表,同在 Excel 菜单中选择""格式——工作表——隐藏"操作一样

eets(""sheet1").Visible=xlSheetVeryHidden '隐藏工作表,不能通过在 Excel 菜单中选择""格式——工作表——取消隐藏"来重新显示工作表

eets(""sheet1").Visible=xlSheetVisible '显示被隐藏的工作表

(1).ProtectContents '检查工作表是否受到保护

Count:=2,

Before:=eets(2)

或 eets(2), , 2 '在第二个工作表之前添加两个新的工作表

eets(3).Copy '复制一个工作表到新的工作簿

eets(3).Copy eets'复制第三个工作表到第二个工作表之前

Width = 20 '改变工作表的列宽为

20

Width =

rdWidth '将工作表的列宽恢复为标准值

s(1).ColumnWidth = 20 '改变工作表列 1的宽度为 20

ght = 10 '改变工作表的行高为 10

ght =

rdHeight '将工作表的行高恢复为标准值

(1).RowHeight = 10 '改变工作表的行 1的高度值设置为 10

eets(1).Activate '当前工作簿中的第一个工作表被激活

eets("Sheet1").Rows(1). = True '设置工作表Sheet1中的行1数据为粗体

eets("Sheet1").Rows(1).Hidden = True '将工作表Sheet1中的行1隐藏

= True '将当前工作表中活动单元格所在的行隐藏

注：同样可用于列。

(""A:A").t '自动调整当前工作表 A

列列宽

lCells(xlCellTypeConstants,xlTextValues) '选中当前工作表中常量和文本单元格

lCells(xlCellTypeConstants,xlErrors+xlTextValues) '选中当前工作表中常量和文本及错误值单元格

**********************

* 单元格/单元格区域 *

**********************

或

Range((xlUp),(xlDown)).Select '选择当前活动单元格所包含的范围,上下左右无空行

'选定当前工作表的所有单元格

Range("A1").ClearContents '清除活动工作表上单元格 A1中的内容

ontents '清除选定区域内容

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").Copy Range("B1") '复制单元格 A1,粘贴到单元格 B1中

Range("A1:D8").Copy Range("F1") '将单元格区域复制到单元格 F1开始的区域中

Range("A1:D8").Cut Range("F1") '剪切单元格区域 A1至 D8,复制到单元格

F1开始的区域中

Range("A1"). Sheets("Sheet2").Range("A1") '复制包含

A1 的单元格区域到工作表 2中以 A1起始的单元格区域中

注：CurrentRegion属性等价于定位命令,由一个矩形单元格块组成,周围是一个或多个空行或列

=XX '将值 XX 输入到所选单元格区域中

'活动窗口中选择的单元格数

'当前选中区域的单元格数

GetAddress=Replace(inks(1).Address,mailto:,"") '返回单元格中超级链接的地址并赋值

TextColor=Range("A1").ndex '检查单元格 A1的文本颜色并返回颜色索引

Range("A1").ndex '获取单元格 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 和 Data2 区域的交叉区域

Range("Data").Count '单元格区域Data 中的单元格数

Range("Data"). '单元格区域 Data 中的列数

Range("Data"). '单元格区域 Data 中的行数

'当前选中的单元格区域中的列数

'当前选中的单元格区域中的行数

'选中的单元格区域所包含的区域数

'获取单元格区域中使用的第一行的行号

'获取单元格区域 Rng 左上角单元格所在列编号

lCells(xlCellTypeAllFormatConditions) '在活动工作表中返回所有符合条件格式设置的区域

Range("A1").AutoFilter Field:=3,VisibleDropDown:=False '关闭由于执行自动筛选命令产生的第 3个字段的下拉列表