经典ExcelVBA代码解析.docx
- 文档编号:28922555
- 上传时间:2023-07-20
- 格式:DOCX
- 页数:15
- 大小:41.40KB
经典ExcelVBA代码解析.docx
《经典ExcelVBA代码解析.docx》由会员分享,可在线阅读,更多相关《经典ExcelVBA代码解析.docx(15页珍藏版)》请在冰豆网上搜索。
经典ExcelVBA代码解析
经典ExcelVBA代码1
VBA代码
VBA基础在大家的关注声中即将告一段落了,有许多经典的VBA操作我们只是作了简要的介绍,想要熟练地使用VBA还需要大家慢慢地去消化和吸收,然后在实践中总结和提高。
最后我们收集了常见的
'启用/禁用所有事件显示/关闭警告框提示框'显示/关闭屏幕刷新
以飨广大的读者,希望对大家有所启示。
Application(Excel程序)篇Application.EnableEvents=True/FalseApplication.DisplayAlerts=True/FalseApplication.ScreenUpdating=True/False
Application.StatusBar="软件报专用"'在地址栏中显示文本,标题栏用Caption属性
Application.Cursor=xlIBeam‘设置光标形状为Ⅰ字形,xlWait为沙漏(等待)形,xlNormal为正常
Application.WindowState=xlMinimized
窗口最小化,xlMaximized最大化,xlNormal为正常
Application.ActivateMicrosoftAppxlMicrosoftWord'开启Word应用程序
Application.TemplatesPath‘获取工作簿模板的位置
Application.CalculateFull'重新计算所有打开的工作簿中的数据
Application.RecentFiles.Maximum=2'将最近使用的文档列表数设为2Application.RecentFiles(3).Open'打开最近打开的文档中的第3个文档Application.AutoCorrect.AddReplacement"sweek","软件报"'自动将输入的"sweek"更正为"软件报"
Application.Dialogs(xlDialogPrint).Show‘显示打印文档的对话框
Application.OnTimeNow+TimeValue("00:
00:
45"),"process"'45分钟后执行指定过程
Application.OnTimeTimeValue("14:
00:
00"),"process"'下午2点执行指定过程
Application.OnTimeEarliestTime:
=TimeValue("14:
00:
00"),_
Procedure:
="process",Schedule:
=False'取消指定时间的过程的执行
工作簿/工作表篇
ActiveWorkbook.Sheets.Count'获取活动工作薄中工作表数
ActiveWorkbook.LinkSources(xlExcelLinks)
(1)‘返回当前工作簿中的第一条链接
ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetHidden‘隐藏工作表,与在Excel菜单中执行
“格式—工作表—隐藏”操作一样
ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetVeryHidden‘隐藏工作表,不能通过在Excel
菜单中执行“格式—工作表—取消隐藏”来重新显示工作表
ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetVisible‘显示被隐藏的工作表
ThisWorkbook.Sheets
(1).ProtectContents‘检查工作表是否受到保护
ActiveSheet.Columns("B").Cut
ActiveSheet.Columns("F").Insert‘以上两句将B列数据移至F列,原C列后的数据左移ActiveSheet.Range(“A:
A”).EntireColumn.AutoFit‘自动调整当前工作表A列的列宽
选中当前工作表中
ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlTextValues)‘选中当前工作表中常量和文本单元格
ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlErrors+xlTextValues)常量和文本及错误值单元格
ActiveSheet.UsedRange.Rows.Count‘当前工作表中已使用的行数
ThisWorkbook.Worksheets.AddThisWorkbook.Worksheets(3),,2‘在第3张工作表之前添加2个新的
工作表
ActiveSheet.MoveAfter:
=ActiveWorkbook._
Sheets(ActiveWorkbook.Sheets.Count)'将当前工作表移至工作表的最后Worksheets(Array(“sheet1”,”sheet2”)).Select'同时选择工作表sheet1和sheet2ActiveSheet.UsedRange.FormatConditions.Delete‘删除当前工作表中应用的条件格式Cells.Hyperlinks.Delete‘取消当前工作表中所有单元格的超链接
ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName‘在页脚显示文件的路径ActiveSheet.PrintPreviewEnablechanges:
=False‘禁用显示在Excel的“打印预览”窗口中的“设置”和“页边距”按钮单元格/单元格区域篇
ActiveSheet.UsedRange.Row‘获取已使用的单元格区域的第一行的行号Range(“A65536”).End(xlUp).Row‘返回A列最后一行(即记录的总条数)cell.Range(“A1”).HasFormula‘检查单元格或单元格区域中的第一个单元格是否含有公式或cell.HasFormula‘工作表中单元格是否含有公式
Target.EntireColumn.Select‘选择单元格所在的整个列,Target.EntireRow.Select为选择单元格所在的整行
ActiveCell.Row‘活动单元格所在的行号,ActiveCell.Column为活动单元格所在的列数ActiveWindow.ScrollRow=2'将当前工作表窗口滚动到第2行
ActiveWindow.ScrollColumn=5'将当前工作表窗口滚动到第5列Worksheets("sheet1").Range("A1:
C5").CopyPicturexlScreen,xlBitmap'将指定的单元格区域的内容复制成屏幕快照
Selection.Hyperlinks.Delete‘删除所选区域的所有链接
ActiveSheet.Cells(1,1).Font.Bold=TRUE‘Bold属性用于设置字体是否为加粗,Size属性设置字
体大小,ColorIndex属性设置字体颜色(其值为颜色索引号),Italic属性设置字型是否为倾斜,Name属性设置字体名称
ActiveSheet.Cells(1,1).Interior.ColorIndex=3‘将单元格的背景色设置为红色
IsEmpty(ActiveCell.Value)'判断活动单元格中是否有值
ActiveCell.Value=UCase(ActiveCell.Value)'将当前单元格中的字符转换成大写
ActiveCell.Value=StrConv(ActiveCell.Value,vbLowerCase)'将活动单元格中的字符串转换成小写
ActiveCell.CurrentRegion.Select'选择当前活动单元格所在的连续的非空区域,也可以用
Range(ActiveCell,UsedRange.End(xlDown)).SelectActiveCell.Offset(1,0).Select'活动单元格下移一行
Range(“B2”).Offset(ColumnOffset:
=1)或Range(“B2”).Offset(,1)‘读取指定单元格右侧单元格中
的数据
Range(“B2”).Offset(Rowoffset:
=-1)或Range(“B2”).Offset(-1)‘读取指定单元格上一行单元格中的数据
Range(“A1”).CopyRange(“B1”)'复制单元格A1中的内容到B1中
Range(“A1:
D8”).CopyRange(“H1”)'将指定单元格区域复制到从H1开始的区域中,用Cut方法可
以实现剪切操作
ActiveWindow.RangeSelection.Value="软件报"'将指定字符串输入到所选单元格区域中
窗体(控件)篇OptionExplicitUserform1.Show
'强制对模块内所有变量进行声明
‘显示用户窗体
LoadUserform1
‘加载一个用户窗体,但该窗体处于隐藏状态
Userform1.Hide
‘隐藏用户窗体
UnloadUserform1或UnloadMe‘卸载用户窗体
Me.Height=Int(0.5*ActiveWindow.Height)‘窗体高度为当前活动窗口高度的一半,宽度用
ActiveWindow.Width属性
UserForm1.ComboBox1.AddItemSheets("Sheet1").Cells(1,1)‘将指定单元格中的数据添加到复合框中
ListBox1.List=MyProduct()‘将数组MyProduct的值添加到列表框ListBox1中
ListBox1.RowSource=”Sheet1!
isum”‘将工作表Sheet1中名为的isum区域的值添加到列表框中
ListBox1.Selected(0)‘选中列表框中的指定的条目
ListBox1.RemoveItemListBox1.ListIndex‘移除列表框中选中的条目
IfMsgBox(“要退出吗?
”,vbYesNo)<>vbYesThenExitSub'返回值不为“是”,则退出
Config=vbYesNo+vbQuestion+vbDefaultButton2'使用常量的组合,赋值组Config变量,并设置第二个按钮为缺省按钮
MsgBox“Thisisthefirstline.”&vbNewLine&“Secondline.”'在消息框中强制换行,也可
用vbCrLf代替vbNewLine。
MsgBox"平均值
为:
"&Format(Application.WorksheetFunction.Average(Selection),"#,##0.00"),vbInformation,"显
示选区平均值"'应用工作表函数返回所选区域的平均值并按指定显示的格式
公式与函数
Application.WorksheetFunction.IsNumber(“A1”)'检查指定单元格中的数据是否为数字
Range(“A:
A”).Find(Application.WorksheetFunction.Max(Range(“A:
A”))).Activate
'激活单元格区域A列中最大值的单元格
Application.MacroOptionsMacro:
=”GetSum”,Category:
=4‘将自定义的GetSum函数指定给Excel中
的“统计函数”类别
Application.MacroOptionsMacro:
=”GetSum”,_
Description:
=”先求和,然后再输出。
”‘为自定义函数GetSum进行功能说明
Application.WorksheetFunction.CountA(Cell.EntireColumn)‘返回该单元格所在列非空单元格的数量,所在行使用EntireRow属性
Application.WorksheetFunction.CountA(Cells)‘返回当前工作表中非空单元格数量图表篇
‘删除工作表中所有的ChartObject对象删除当前工作簿中所有的图表工作表
Worksheets("Sheet1").ChartObjects
(1).Chart._
命名为MyChart.gif
经典ExcelVBA代码2
EXCEL(VBA)~SQL经典写法范本汇集
A、根据本工作簿的1个表查询求和写法范本
Sub查询方法一()
SetCONN=CreateObject("ADODB.Connection")
CONN.Open"provider=microsoft.jet.oledb.4.0;extendedproperties=excel8.0;datasource="&ThisWorkbook.FullName
sql="select区域,存货类,sum(代销仓入库数量),sum(代销仓出库数量),sum(日报数量)from[sheet4$a:
i]where区域='"&[b3]&"'andmonth(日期)='"&Month(Range("F3"))&"'groupby区域,存货类"
Sheets("sheet2").[A5].CopyFromRecordsetCONN.Execute(sql)
CONN.Close:
SetCONN=Nothing
EndSub
Sub查询方法二()
SetCONN=CreateObject("ADODB.Connection")
CONN.Open"dsn=excelfiles;dbq="&ThisWorkbook.FullName
sql="select区域,存货类,sum(代销仓入库数量),sum(代销仓出库数量),sum(日报数量)from[sheet4$a:
i]where区域='"&[b3]&"'andmonth(日期)='"&Month(Range("F3"))&"'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;"&_
"extendedproperties=excel8.0;datasource="&ThisWorkbook.FullName
Sheet3.Activate
Sql="selecta.存货类,a.fh,b.hkfrom(select存货类,sum(本月发货数量)"_
&"asfhfrom[入库$]where存货类isnotnulland区域='"&[b2]_
&"'andmonth(日期)="&[d2]&"groupby存货类)asa"_
&"leftjoin(select存货类,sum(数量)ashkfrom[回款$]where存货类"_
&"isnotnulland区域='"&[b2]&"'andmonth(开票日期)="&[d2]&""_
&"groupby存货类)asbona.存货类=b.存货类"
Range("a5").CopyFromRecordsetconn.Execute(Sql)
EndSub
C、根据本文件夹下其他工作簿1个表区域的区域求和
Sub在工作表1汇总本文件夹下001工作薄的表1分数列查询汇总()Setconn=CreateObject("ADODB.Connection")
conn.Open"dsn=excelfiles;dbq="&ThisWorkbook.Path&"\001.xls"sql="selectsum(分数)from[sheet1$]"
Sheets
(1).[a2].CopyFromRecordsetconn.Execute(sql)conn.Close:
Setconn=Nothing
EndSub
Sub在工作表1汇总本文件夹下001工作薄的表1A1:
A10查询汇总()
Setconn=CreateObject("ADODB.Connection")
conn.Open"provider=microsoft.jet.oledb.4.0;extendedproperties='excel8.0;hdr=no;';datasource="&ThisWorkbook.Path&"\001.xls"
sql="selectsum(f1)from[sheet1$a1:
a10]"
Sheets
(1).[A5].CopyFromRecordsetconn.Execute(sql)conn.Close:
Setconn=Nothing
EndSub
Sub在工作表1汇总本文件夹下001工作薄的表1分数列A1:
A7查询并msgbox表达汇总()Setconn=CreateObject("ADODB.Connection")
Setrr=CreateObject("ADODB.recordset")
conn.Open"dsn=excelfiles;dbq="&ThisWorkbook.Path&"\001.xls"
sql="selectsum(分数)from[sheet1$a1:
a7]"
Sheets
(1).[A8].CopyFromRecordsetconn.Execute(sql)
rr.Opensql,conn,3,1,1
MsgBoxrr.fields(0)conn.Close:
Setconn=Nothing
EndSub
D、根据本文件夹下其他工作簿多个表区域的单列区域查询求和
sub本文件夹下其他工作簿的每个工作簿的第4列30行查询求和
DimcnAsObject,f$,arr&(1To30),i%Application.ScreenUpdating=FalseSetcn=CreateObject("adodb.connection")f=Dir(ThisWorkbook.Path&"\*.xls")DoWhilef<>""
Iff<>ThisWorkbook.NameThen
cn.Open"provider=microsoft.jet.oledb.4.0;extendedproperties='excel8.0;hdr=no;';datasource="&ThisWorkbook.Path&"\"&f
Range("d5").CopyFromRecordsetcn.Execute("selectf4from[基表1$a5:
d65536]")cn.Close
Fori=1To30
arr(i)=arr(i)+Range("d"&i+4)
Nexti
EndIf
f=Dir
Loop
Range("d5").Resize(UBound(arr),1)=WorksheetFunction.Transpose(arr)Application.ScreenUpdating=True
EndSub
E、根据本文件夹下其他工作簿多个表区域的多列区域查询求和
sub本文件夹下其他工作簿的每个工作簿的第B\C\D列25行查询求和
DimcnAsObject,f$,arr&(1To25,1To3),i%
Application.ScreenUpdating=False
Setcn=CreateObject("adodb.connection")
f=Dir(ThisWorkbook.Path&"\*.xls")
DoWhilef<>""
Iff<>ThisWorkbook.NameThen
cn.Open"provider=microsoft.jet.oledb.4.0;extendedproperties='excel8.0;hdr=no;';datasource="&ThisWorkbook.Path&"\"&f
Range("b6").CopyFromRecordsetcn.Execute("selectf2,f3,f4from[基表3$a6:
e65536]")cn.Close
Fori=1To25
Forj=1To3
arr(i,j)=arr(i,j)+Cells(i+5,j+1)
Nextj
Nexti
EndIf
f=Dir
Loop
Range("b6").Resize(UBound(arr),3)=arr
Application.ScreenUpdating=True
EndSub
F、其他相关知识整理'用excelSQL方法
'conn是建立的连接对象,用open打开
'通过CreateObject("ADODB.Connection")这一句建立了一个数据库连接对象conn
'在工程中就不再需要引用“MicrosotActiveXDataObjects2.0Library对象“
'设置对象conn为一个新的ADO链接实例,也可以用setconn=NewADODB.Connection'conn.Close表示关闭conn连接
'Setconn=Nothing是把连接对象
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 经典 ExcelVBA 代码 解析