excelvba代码应用到所有表格.docx
《excelvba代码应用到所有表格.docx》由会员分享，可在线阅读，更多相关《excelvba代码应用到所有表格.docx（8页珍藏版）》请在冰豆网上搜索。
excelvba代码应用到所有表格
竭诚为您提供优质文档/双击可除
excel,vba代码应用到所有表格
篇一：
excel常用Vba代码
删除b列中字符串数值少于21的单元格所在的行
sub删除行（）
r=Range（"b65536"）.end（xlup）.Row行数
Forh=rto1step-1
ifcells（h,2） next
endsub
-------------------------
【工作表合并】将同一工作簿中的所有工作表合并到一个工作表中
新建一个工作表，写入代码[在新建的工作表标签处右键查看代码（找不到的直接按一下alt+F11）把下面的代码复制进去然后点上面的运行运行子程序即可]：
sub合并当前工作簿下的所有工作表（）
application.screenupdating=False
Forj=1tosheets.count
ifsheets（j）.nameactivesheet.namethen
x=Range（"a65536"）.end（xlup）.Row+1
sheets（j）.usedRange.copycells（x,1）
endif
next
Range（"b1"）.select
application.screenupdating=true
msgbox"当前工作簿下的全部工作表已经合并完毕！
",vbinformation,"提示"
endsub
*********************************************************
代码这样写也行：
subc（）
Fori=sheets.countto2step-1
sheets（i）.select
sheets（i）.usedRange.copy
sheets
（1）.select
cells（cells（65000,1）.end（xlup）.Row+1,1）.select
activesheet.paste
sheets（i）.delete
nexti
endsub
************************************************************
把一个工作簿中的所有表单合并成一个表单，怎么去掉重复的表头、标题行？
方法如下：
subc（）
Fori=sheets.countto2step-1
sheets（i）.usedRange.offset
（1）.copysheets
（1）.cells（65536,1）.end（xlup）.offset
（1）nexti
endsub
说明：
函数oFFset（reference,rows,cols,height,width）以指定的引用为参照系，通过给定偏移量得到新的引用。
返回的引用可以为一个单元格或单元格区域。
并可以指定返回的行数或列数。
通俗的讲就是oFFset（参考单元格，移动的行数，移动的列数，所要引用的行数，所要引用的列数）参考《关于offset函数》
第三行中第一个offset
（1）是假设要要去掉的表头行数，如果有2行表头，就改成offset
（2），要去掉几行表头括号中的数字就改成几。
第二个offset
（1）表示合并以后表格与表格之间要间隔的空行，offset
（1）表示不留空行，offset
（2）表示间隔1行空行，以此类推。
也可以这样写：
subc（）
Fori=sheets.countto2step-1
sheets（i）.usedRange.offset
（2）.copysheets
（1）.cells（cells（65536,1）.end（xlup）.Row+1,1）.offset（0）‘这个offset（0）可以不要
nexti
endsub
****************************************************************
或者用以下宏代码
将同一工作簿中的所有工作表合并到一个新建的工作表中
按alt+F11调出ＶＢＡ窗口，插入一个模块，然后把下面的代码复制进去。
subhz（）
setnewsheet=sheets.add（type:
=xlworksheet）生成一个新表
sheets（newsheet.index）.movebefore:
=sheets
（1）将此新表移动到最前面
Fori=2toworksheets.count
sheets（i）.usedRange.copynewsheet.cells（[a65536].end（xlup）.Row+2,1）将其他表的已使用区域复制到新表中
nexti
msgbox"合并完成"
endsub
这段代码很简单，其中第四行中用FoR循环得到当前工作簿中的所有工作表，第五行中使用usedRange得到每个工作表的“已使用区域”，然后用copy方法把这些“已使用区域”中的内容复制到新建工作表中。
语句cells（[a65536].end（xlup）.Row+2,1）的作用是得到新建工作表的Ａ列中的最后空白单元格（即要在哪
个位置粘贴），加2的作用是使每次复制数据间隔2行空格（此处应表示间隔1行空格，加1的话，表示合并的表格与表格之间不留空格）。
回到excel窗口，执行“工具-宏-宏”中的“hz”宏就会自动合并工作表了。
（经本人测试，不能使用右键点击标签查看代码再粘入代码的方式，应该运用菜单栏插入模块的方式）---------------------------------------------------------------
【工作簿合并】
将需要合并的工作簿文件放置在一个文件夹中，并新建一个工作簿，写入代码：
sub合并工作薄（）
dimFilestoopen
dimxasinteger
onerrorgotoerrhandler
application.screenupdating=False
Filestoopen=application.getopenFilename_
（FileFilter:
="microsoftexcel文件（*.xls）,*.xls",_
multiselect:
=true,title:
="要合并的文件"）
iftypename（Filestoopen）="boolean"then
msgbox"没有选中文件"
gotoexithandler
endif
x=1
whilex workbooks.openFilename:
=Filestoopen（x）
sheets（）.moveafter:
=thisworkbook.sheets（thisworkbook.sheets.count）
x=x+1
wend
exithandler:
application.screenupdating=true
exitsub
errhandler:
msgboxerr.description
Resumeexithandler
endsub
------------------------
显示隐藏的工作表
subshowallsheets（）使当前工作簿中的所有工作表都显示（即将隐藏的工作表也显示）"
dimwsasworksheet
Foreachwsinsheets
ws.Visible=truenextws
endsub
--------------------------------------------------------
根据sheet2中的数据，检查sheet1中的重复数据，并且进行后续的操作（将重复数据删除或者拷贝出来）的操作。
application.screenupdating=False
c=2第一个工作表检测b列
x=1第一条检测结果放在第1行
count=1
First_sheet_row=sheets
（1）.cells（65536,c）.end（xlup）.Row
second_sheet_row=sheets
（2）.cells（65536,c）.end（xlup）.Row
dimto_be_deleted（5369）asstring
Forj=1to5368
to_be_deleted（j）=trim（cstr（sheets
（2）.cells（j,2）.Value））
nextj
Fori=1toFirst_sheet_row
First_value=trim（cstr（sheets
（1）.cells（i,c）.Value））
Forj=1to5368
msgboxto_be_deleted（j）
ifFirst_value=to_be_deleted（j）then
sheets
（1）.Range（"a"sheets
（2）.cel（excel,vba代码应用到所有表格）ls（j,3）.Value="copied"
application.cutcopymode=False
sheets
（1）.Range（"a"sheets（3）.pastedestination:
=sheets（3）.Range（"a"sheets（3）.paste
count=count+1
i=i-1
endif
nextj
nexti
application.screenupdating=true
msgbox"共删除了"extendedproperties=excel8.0;datasource=""andmonth（日期）="groupby区域,存货类"
sheets（"sheet2"）.[a5].copyFromRecordsetconn.execute（sql）
conn.close:
setconn=nothing
endsub
-----------------
sub查询方法二（）
setconn=createobject（"adodb.connection"）
conn.open"dsn=excelfiles;dbq=""andmonth（日期）="groupby区域,存货类"
sheets（"sheet2"）.[a5].copyFromRecordsetconn.execute（sql）
conn.close:
setconn=nothing
endsub
***********************************************************************************************
b、根据本工作簿2个表的不同类别查询求和写法范本
sub根据入库表和回款表的区域名和月份分别求存货类发货数量和本月回款数量查询（）
setconn=createobject（"adodb.connection"）
conn.open"provider=microsoft.jet.oledb.4.0;"datasource=""andmonth（日期）=""andmonth（开票日期）="dbq="extendedproperties=excel8.0;hdr=no;;datasource="dbq="声明a为整型变量
dima声明a为变体变量
dimaasstring声明a为字符串变量
dimaascurrency,bascurrency,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=3.4567选择当前单元格所在区域
在excel97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。
只要将该段代码加入到你的模块中。
submy_select
selection.currentRegion.select
endsub
返回当前单元格中数据删除前后空格后的值
submy_trim
msgboxtrim（activecell.Value）
endsub
单元格位移
submy_offset
activecell.offset（0,1）.select当前单元格向左移动一格
activecell.offset（0,-1）.select当前单元格向右移动一格
activecell.offset（1,0）.select当前单元格向下移动一格
activecell.offset（-1,0）.select当前单元格向上移动一格
endsub
如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往
submy_offset之下加一段代码onerrorresumenext
注意以下代码都不再添加sub“代码名称”和endsub请自己添加!
给当前单元格赋值
activecell.Value="你好！
！
！
"
给指定单元格赋值
例如：
Ａ１单元格内容设为"ＨＥＬＬＯ"
Range（"a1"）.value="hello"
又如：
你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ"
1.
sheets（"sheet2"）.select
range（"a1"）.value="hello"
或
2.
sheets（"sheet1"）.Range（"a1"）.Value="hello"
说明：
1.sheet2被选中，然后在将“hello"赋到a1单元格中。
2.sheet2不必被选中，即可“hello"赋到sheet2的a1单元格中。
隐藏工作表
隐藏sheet1这张工作表
sheets（"sheet1"）.Visible=False
显示sheet1这张工作表
sheets（"sheet1"）.Visible=true
打印预览
有时候我们想把所有的excel中的sheet都打印预览，请使用该段代码，它将在你现有的工作簿中循环，直到最后一个工作簿结束循环预览。
dimmyasworksheet
Foreachmyinworksheets
my.printpreview
nextmy
得到当前单元格的地址
msgboxactivecell.address
得到当前日期及时间
msgboxdate删除所有文字、批注、格式
返回选定区域的行数
msgboxselection.Rows.count
返回选定区域的列数
msgboxselection.columns.count
返回选定区域的地址
selection.address
忽略所有的错误
oneRRoRResumenext
遇错跳转
onerrorgotoerr_handle
中间的其他代码
err_handle:
标签
跳转后的代码
删除一个文件
kill"c:
1.txt"
定制自己的状态栏
application.statusbar="现在时刻:
"&time
恢复自己的状态栏
application.statusbar=false
用代码执行一个宏
application.Runmacro:
="text"
滚动窗口到a1的位置
activewindow.scrollRow=1
activewindow.scrollcolumn=1
定制系统日期
dimmydate,myday
mydate=#12/12/69#
myday=day（mydate）
返回当天的时间
dimmydate,myyear
mydate=date
myyear=year（mydate）
msgboxmyyear
inputbox
xx=inputbox（"enternumberofmonthstoadd"）
得到一个文件名
dimkkasstring
kk=application.getopenFilename（"excel（*.xls）,*.xls",title:
="提示：
请打开一个excel文件：
"）
msgboxkk
打开zoom对话框
application.dialogs（xldialogzoom）.show
激活字体对话框
application.dialogs（xldialogactivecellFont）.show
打开另存对话框
dimkkasstring
kk=application.getsaveasFilename（"excel（*.xls）,*.xls"）
workbooks.openkk
1excle快捷键大全
对工具栏进行操作的快捷键
激活菜单栏，F10，alt
选定前一个或下一个工具栏，ctrl+tab或ctrl+shift+tab
选定工具栏中的下一个或前一个按钮或菜单，tab或shift+tab（当某个工具栏被激活时）
打开选定的菜单，enter
运行选按钮的操作，enter
在选定的文本框中输入文本，enter
在对话框中使用的快捷键
取消当前任务,esc
单击相应命令，alt+下划线字母
单击选定的按钮,enter
在选项中前移，tab
在选项后移,shift+tab
在选项卡中前移,ctrl+tab
在选项卡中后移,ctrl+shift+tab
刷新“另存为”或“打开”对话框,F5
插入、删除和复制选定区域的快捷键
复制选定区域，ctrl+c
粘贴选定区域,ctrl+V
剪切选定区域,ctrl+x
清除选定区域的内容，delete
插入空白单元格,ctrl+shift+加号
删除选定区域,ctrl+-
撤消最后一次操作,ctrl+z
使用“office助手”需要用到的快捷键
关闭“office助手”提供的消息,esc
通过“office助手”获取帮助信息,F1
显示下一项提示,alt+n
显示前一项提示,alt+b
在向导中显示或隐藏“office助手”,空格键
对窗口进行操作的快捷键
切换到下一个程序,alt+tab
切换到前一个程序,alt+shift+tab
显示windwos“开始”菜单,ctrl+esc
关闭活动工作薄窗口,ctrl+w
恢复活动工作薄窗口,ctrl+F5
切换到下一个工作薄窗口，ctrl+F6
切换到前一个工作薄窗口,ctrl+shift+F6
执行“移动”命令（菜单栏中的工作薄图标菜单）,ctrl+F7
运行“大小”命令（菜单栏中的工作薄图标菜单）,ctrl+F8
将工作薄窗口最小化为图标,ctrl+F9
升级会员 