VBA典型的技巧和示例

创建一个工作簿

sub xxx（）
dim wb as workbook ，sht as worksheet ‘定义对象
set wb=workbook.add 
set sht=wb.worksheet(1)
with sht
.name="woqu"
.range("A1:A7")=array("1,""2","3")
end with
wb.saveas thiswork.path & "\员工花名册.xls"
activeworkbook.close
end sub（）

判断工作簿是否打开

dim i as integer
for i = 1 to workbooks.count
if workbooks（i）.name=“成绩表.xls” then
masbpox“文件已经打开”
exit sub
end if
next
msgbox “文件没打开”
end sub

判断工作簿是否存在

dim fil as string
fil = thisworkbook.path &“\员工花名册.xls”
if len（dir（fil））>0 then
msgbox"工作簿已存在"
else
msgbox"工作簿已不存在"
end if
’dir返回的是文件的名称，如果是空字符串的话，就是没有的意思

向尚未打开的工作簿中录入数据

dim wb as string ，xrow as integer ，arr
wb=thisworkbook.path&“\员工花名册.xls”
workbook.open（wb）
with activeworkbook.worksheets（1）
xrow=.range（“A1”）.currentregion.rows.count+1'获取表格里的第一条空行号
arr= array（xrow-1，“1”，“2”，“2”）
.cells（xrow，1）,resize(1,6)=arr
end with
activeworkbook.close savechanges:=true '关闭工作簿，保存修改

隐藏活动工作表外的所有工作表

dim sht as worksheet
for each sht in worksheets
if sht.name<>activesheet.name then
sht.visible=xlsheetveryhidden '深度隐藏工作表，不能通过格式菜单显示
end if
next

批量新建工作表

dim i as integer ，sht as worksheet
i=2
set sht = worksheet（“成绩表”）
do while sht.cell（i，“C”）<> ""
worksheet.add after:=worksheets(worksheet.count)'在最后面的工作表插入
activesheet.name=sht.cells(i,"C").value
i=i+1
loop

批量对数据进行分类

dim i as long，bj as string，rng as range
i=2
bj=cells（i,"C"）.value
do while bj<> ""
set rng=worksheets(bj).range("A65536").end(xlup).offset(1,0)
cells(i,"A").resize(1,7).copy rng '将记录复制到相应的工作表中
i=i+1
bj=cells(i,"C").value
loop

将工作表保存为新工作簿

'把哥哥工作表以单独的文件保存在相应文件夹中
application.screenupdating = false  '关闭屏幕更新
dim folder as string
folder = thisworkbook.path &“\班级表”
if len(dir(folder,vbdirectory))=0 then mkdir folder
dim sht as worksheet
for each sht in worksheets
sht.copy
activeworkbook.saveas folder & “\” & sht.name & “.xls”
activeworkbook.close
next
application.screenupdating = true

快速合并多表数据

rows("2:65536").clear
dim sht as  worksheet,xrow as integer ,rng as range
for each sht in worksheets
 if sht.name<>activesheet.name then
 set rng = range("A65536").end(xlup).offset(1,0)
 xrow=sht.range("A1").currentregion.rows.count-1
 	sht.range("A2").resize(xrow,7).copy rng
 	end if
 next
 

汇总同文件夹下多工作簿数据

dim bt as range ,r as long,c as long
r=1
c=8
range(cell(r+1,"A"),cells(65536,"C")).clearcontents
application.screenupdating = false 
dim filename as string, wb as workbook,erow as long,fn as string ,arr as variant 
filename=dir(thisworkbook.path & "\*.xls")
do while filename <>""
if filename<> thisworkbook.name then
erow=range("A1").currentregion.rows.count+1
fn = thisworkbook.path & "\" & filename
set wb = getobject(fn) '把fn代表的工作簿对象赋给变量
set sht = wb.worksheets(1)
arr = sht.range(cell(r+1,"A"),cells(65536,"C")).end(xlup).offset(0,8))
cells(erow,"A").resize(ubound(arr,1),ubound(arr,2))=arr
wb.close flase
end if
filename=dir
loop
application.screenupdating = truw

为工作表建立目录

rows（"2:65536"）.clearcontents
dim sht as worksheet,irow as integer
irow = 2 
for each sht in worksheets
 cells(irow,"A").value= irow -1
Activesheet.hyperlinks.add anchor:=cells(irow,"B"),address:="",_
subaddress:="'" & sht.name & "'!A1",texttodisplay:=sht.name
irows=irow + 1
next