常用代码锦集

1.工作表

Worksheets.Add before:=Worksheets(1) ‘在sheet1前增加一个工作表

Worksheets.Add after:=Worksheets(1) ’在工作表sheet1后增加一个工作表

Worksheets.Add Count:=3 ‘在当前工作表前增加3个工作表

Worksheets.Add after:=Worksheets(1), Count:=3 ‘在sheet1后增加3个工作表

Worksheets("Sheet10").Delete ‘删除工作表

Worksheets("Sheet2").Copy before:=Worksheets("Sheet2") ‘在sheet2前复制一个副本

Worksheets("Sheet2").Copy after:=Worksheets("Sheet2") ‘在sheet2后复制一个副本

Worksheets("Sheet2").Copy ‘复制sheet2到新的工作簿

2.工作簿

Workbooks.Open Filename:="E:\\baiduyundownload\打开工作簿实例.xls" ‘打开工作簿

Workbooks.Open Filename:=D:\\a.xls, UpdateLinks:=0, editable:=True '打开文件,属性设置为不更新,可编辑

a = Workbooks("VBA函数记录.xls").Path‘返回工作簿的绝对路径不包含文件名

a=ThisWorkbook.FullName ‘本工作簿的绝对路径

a = CurDir‘返回当前工作簿的路径，不包含文件名

Workbooks("打开工作簿实例.xls").Close‘关闭工作簿

Workbooks("打开工作簿实例.xls").Close savechanges:=True’ 关闭并保存工作簿

ThisWorkbook.Save‘本工作簿保存

ThisWorkbook.SaveAs Filename:="E:\备份1.xls"本工作簿保存为，并打开新工作簿

ThisWorkbook.SaveCopyAs Filename:="E:\备份.xls" ‘本工作簿另存为，留在本工作簿

Workbooks.Add ’增加工作簿

Workbooks("打开工作簿实例.xls").Activate

3.单元格

Range("a1").Select         '单元格

Range("a:a").Select        '列

Range("1:3").Select       '行

Range("a1:b10").Select     '相邻区域

Range("a1:d7,c4:e8").Select  '不相个邻区域

Range("a1:b10").Select '一般写法

Range("a1", "b10").Select '变化写法1

Range(Range("a1"), Range("b10")).Select '变化写法2

Range("a:a").Count '计数工作表最大的行数

Range("1:1").Count '计算工作表最大的列数

Application.CountA(Range("a:a")) '计算工作表已使用的行数

Application.CountA(Range("1:1")) '计算工作表已使用的列数

i = Application.CountA(Range("c:c")) '找到c列中已使用的最后一个单元格位置

Range("b2:d4").Range("b2").Select '相对引用的写法,参照前一个range的左上单元格

Range("c3:e5")(2).Select ‘选定d3，引用顺序是：从左向右，从上到下选取

Range("a1:c4")(3, 2).Select '利用行号与列号定位，选中B3

Cells(3, 4).Select '行列号均为数字，cells不能引用一个区域，只能引用一个单元格

Cells(2, "c").Select '行为数字，列为列标字母

Range("b3:f11").Cells(2, 2).Select

Range("b3:f11").Cells(6).Select '从左到右，从上到下

Range("b3:f11")(6).Select '与上一句相等

Range(Range("b1"), Range("f11")).Select '这种嵌套方法写变量比较麻烦

Range(Cells(3, 2), Cells(11, 6)).Select '这种嵌套方法写变量比较方便

[a1].EntireColumn.Select  选取a1单元格所在整列，后面还有知识要学

[a1:a4].EntireRow.Select ‘选取a1:a4所在的整行，后面还有知识要学

[a3].Select ' 单元格引用

[b2:c6].Select '单元格区域引用

[a3,b2:c6,b8:d12].Select '多区域引用

[a:a].Select '整列引用

[1:1].Select '整行引用

Range(Range("a1"), Range(Chr( + b) & a)).Select '利用chr函数，让字母形式的列号也支持变量

Columns(1).Select‘列引用

Columns("b").Select‘列引用

Columns("c:e").Select‘列引用

Rows(1).Select ‘行引用

Rows("2").Select‘行引用

Rows("3:4").Select‘行引用

Range("1:1").Select ‘行引用

Range("2:4").Select‘行引用

Range("a:a").Select‘列引用

Range("b:d").Select‘列引用

[a9] = [b2:f2].Address(1, 1)  '绝对引用 返回$B$2:$F$2

[b9] = [b2:f2].Address(0, 0)  '相对引用，返回B2:F2

[c9] = [b2:f2].Address(1, 0)   '混合引用，返回B$2:F$2

[d9] = [b2:f2].Address(0, 1)   '混合引用，返回$B2:$F2

Range("a1:d8").Cut Range("f1") '将单元格区域剪切到指定的区域

Range("f1:i8").Copy Range("a1") '将单元格区域复制到指定的区域

[a2].Resize(i, j).Copy Sheet2.[a1].Offset(k) '将单元格区域复制到指定的区域

Range("a10:d17") = Range("a1:d8").Value 等号后的区域一定要加value.否则不成功

Worksheets("Sheet2").Range("A2") = 100 ‘单元格赋值

a = Worksheets("sheet2").[a2].Value‘从单元格取值

a = Sheet1.[a65536].End(xlUp).Row ‘找到A列最后一个有数据的单元格，其中a65536可以用a:a代替

k = Cells(1, "n").End(xlToLeft).Column ‘找到n1单元格所在行最右侧数据的列号

a = Application.CountA(Range("a:a")) ‘计算非空单元格个数，空行不计算在内

Sheet1.UsedRange.Select ‘已使用的单元格全选，没内容有格式也会选到

[a1].CurrentRegion.Select‘有一个区域与usedrange一样，有多个则只选一个

endrng = Cells.Find("*", , xlFormulas, , , xlPrevious) ‘寻找最后一个有内容的单元格

查找最后的单元格

a = Cells(Rows.Count, 1).End(xlUp).Row 'end属性

b = Columns(1).Find("*", , , , , xlPrevious).Row 'find方法

c = Cells.SpecialCells(xlCellTypeLastCell).Row 'specialcells方法

d = Sheet1.UsedRange.Rows.Count 'usedrange属性

e = [a1].CurrentRegion.Rows.Count 'currentregion属性

f = WorksheetFunction.CountA([a:a]) '工作表函数counta

g = Application.CountIf([a:a], "<>") '工作表函数countif

Cells(Myr, 9).Resize(1, 12) = .Cells(r1.Row, 2).Resize(1, 12).Value '从指定单元格行扩展12列存入r1单元格扩展12列数据

Cells(m + 1, 7) = Sheet2.Range(arr(a)).Offset(2, 3) ‘选定单元格下移2行3列后的单元格

[a1:d1].Offset(1, 2).Select ‘将a1:d1单元格整体偏移1行2列，偏移后也区域尺寸不变

Cells(m + 1, 9).NumberFormatLocal = "yyyy-m-d" '设置日期格式为年月日

Cells(m + 1, 1).NumberFormatLocal = "0.00_ " '将数据格式设置为保留两位小数

Range("a4", "j4" ).ClearContents ‘清楚单元格内容，不清除格式

ActiveSheet.Rows("2:65536").Clear ‘活动工作表从2到65536行清除内容，包括格式

4.文本查找定位

MyChar = Chr(65)    ' 返回 A。大写A-Z为65-90，小写a-z 为97-122

Filepath = "C:\\WINDOWS\\system32"；a = InStrRev(Filepath, "\\")最后一个\出现的位数，例子第11位

a = InStr(Filepath, "\\")‘最前一个\出现的位数，例子第三位

a = Left(Filepath, InStrRev(Filepath, "\\") - 1)‘取左字符串，例子C:\\WINDOWS

a=Right(Sht.Name, 1) ‘在sht工作表名称右侧取一个字符

Len(Range("A2"))‘返回单元格内文本长度

Cells(Myr, 2) = Mid(wb1.Path, aa + 1) '取出\后面的文件夹名称填入本表相应行的第二列，语法为Mid(string, start[, length])取出string中从start位置开始向后的长度为length的字符串，可省略length。 Path返回的是文件所在文件夹的路径，不包含文件名。

r1 = .[a:a].Find("1", , , 1)  '在a列中精确查找1值所在的单元格，也可以用find（”1”, Lookat:=xlwhole）表达式.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

Set r = Sheet2.[d:d].Find("HC", , , 1) '使用find和findnext找出d列所有HC存入arr数组

f = r.Address

Do

i = i + 1

arr(i) = r.Address

Set r = Sheet2.[d:d].FindNext(r)

Loop While Not r Is Nothing And r.Address <> f

字符串查找方法（A字符串是否包含B字符串）：

方法一：用like函数。例如a=“abcd” like “*bc*”。返回值为True

方法二：用Instr函数。例如 a= InStr(S1,S2),查找S2在S1中出现的位置，如果为0就是没有，如果有就会返回所在S1中的第几位。

5.数组

arr3 = Application.Transpose(arr2)‘'数组转置

arr(3) = "我" 数组赋值

arr1 = [{"A数组赋值，“，”号为行，生成一维数组，下标从1开始

arr2 = Application.Transpose([{1;2;3;4}])数组赋值，“；”号为列，生成二维数组，转置

arr = Array(1, 2, 3, 4)，数组赋值，一维数组，下标从0开始

arr1 = Array(Array("a", "b"), Array(1, 2, 3))数组赋值，2行3列

arr = Application.Transpose([a1:a4]) '注意：当向数组中批量写入多行，结果就是二维数组

Range("d1:d4" ) = arr 读取数组数值

[e2].Resize(k, 2) = arr1 '循环结束后将arr1的结果赋值给单元格区域，注意对准尺寸

WorksheetFunction.Sum(arr) 返回数组和值

WorksheetFunction.Average(arr) 返回数组平均值

WorksheetFunction.Max(arr) 返回数组最大值

WorksheetFunction.Min(arr) 返回数组最小值

WorksheetFunction.Small(arr, k) 返回数组第k格极小值

WorksheetFunction.Large(arr, k) 返回数组第k格极大值

UBound(arr, 3) 用来确定数组第3维的上界

LBound(arr) 用来确定数组某一维的下界

ReDim [Preserve] varname( ) [As type]'可以使用 ReDim 语句反复地改变数组的元素以及维数的数目

ReDim arr(1 To 5) ‘重新定义arr为1到5

ReDim Preserve arr(1 To 5) ‘重新定义arr为1到5，保留原来的数据

6.循环语句结构

For Each sht In Worksheets Next sht

If Not c <> "" Then Exit For '如果f1数据为空,则退出循环

If rs = 1 Then GoTo 100  带goto跳转的语句结构

Range("a2:d" & rs).Copy Sheets("出差记录表").Range("a" & crs)

End

100:

MsgBox "没有要保存的数据！"

End Sub

For循环如何想倒序从大到小执行就要在for后面加上step -1

7.通用声明

Application.DisplayAlerts = False ‘去除警告提醒

Application.ScreenUpdating = False ‘去除屏幕更新

On Error Resume Next '程序出错继续执行下一个语句

On Error GoTo 0 ‘程序出错转到 0

8.其他函数

fun = Int(Rnd() * 10) + 1‘自定义fun函数返回固定值

Application.Volatile True

fun1 = Int(Rnd() * 10) + 1 ‘自定义fun1函数按F9返回动态值

Application.WorksheetFunction.CountIf(Range("A2:A8"), ">=2")‘查找有多少个满足条件的条目，其中application.可以省略

Cells(Myr, 6) = Application.Max(.Range("r6:r8)) '取出r6:r8中的最高值

MyNumber = Int(99.8) ' 返回 99，如果 number 为负数，则 Int 返回小于或等于 number 的第一个负整数。

MyNumber = Fix(99.2)    ' 返回 99，如果 number 为负数， Fix 则会返回大于或等于 number 的第一个负整数。

MyResult = 10 Mod 5    ' 返回 0，用来对两个数作除法并且只返回余数

MyCheck = IsNumeric(MyVar) ' 返回 True，返回 Boolean 值，指出表达式的运算结果是否为数

9.文件遍历操作代码

Dim fso As New FileSystemObject  ‘遍历当前文件夹中的子文件夹

StartFolder = ThisWorkbook.Path  

Set fd = fso.GetFolder(StartFolder)

If fd.SubFolders.Count = 0 Then Exit Sub

For Each sfd In fd.SubFolders

cntFiles = cntFiles + 1

arrFiles(cntFiles) = sfd.Path

Next

使用前需要加载工具-引用 Mecro script runtime 选项也可以在代码加入Set fs = CreateObject("Scripting.FileSystemObject")但是代码还不会用（例子见FileSystemObject操作全集）

Dir(MyPath & "*.xls") ' 遍历MyPath文件夹中所有xls文件,其中xlsm也会被搜索到,只返回文件名称

MyName = Dir(D:\\*.xls") ‘使用Dir命令遍历本文件夹下所有后缀为xls的文件

Do While MyName <> ""

If MyName <> ThisWorkbook.Name Then '

Workbooks.Open Filename:=MyPath & MyName, UpdateLinks:=0, editable:=True 

End If

MyName = Dir '继续遍历下一个excel文件

Loop

With GetObject(绝对路径)‘使用GetObject获取指定路径的文件

arr = .Sheets(1).UsedRange

.Close False

End With 

语法：GetObject([pathname] [, class])，前面加上循环路径就可以遍历文件夹下所有excel文件并提取其中的内容了。暂时尚未使用过。

10.备注操作

添加EXCL备注 Range("A1").AddComment Text:="我的批注"

判断是否存在备注 Range("A1").Comment Is Nothing

更改备注 Range("A1").Comment.Text Text:="新备注"

隐藏备注 Range("A1").Comment.Visible = False

删除EXCEL备注 Range("A1").Comment.Delete

备注高度更改Range("G" & i).Comment.Shape.Height = 550

备注宽度更改Range("G" & i).Comment.Shape.Width = 200

11.单元格格式设置：

Cells(1, 1).NumberFormatLocal = "yyyy-m-d" '设置日期格式为年月日

Cells(m + 1, 1). NumberFormatLocal = "0.00_ " '设置为保留两位小数

Cells(m + 1, 1). NumberFormat = "@" ‘设置单元格为文本格式

Cells(1, 1).Font.ColorIndex = 3 '字的颜色号为3 红色

Cells(1, 1).Interior.ColorIndex = 3 ' 背景的颜色为3 红色

Cells(2, 1).Font.Color = RGB(0, 255, 0) '字的颜色绿色

Cells(2, 1).Interior.Color = RGB(0, 0, 255) '背景的颜色蓝色