VBA语句汇总.docx
- 文档编号:5761755
- 上传时间:2023-01-01
- 格式:DOCX
- 页数:13
- 大小:23.59KB
VBA语句汇总.docx
《VBA语句汇总.docx》由会员分享,可在线阅读,更多相关《VBA语句汇总.docx(13页珍藏版)》请在冰豆网上搜索。
VBA语句汇总
程序错误继续执行
OnErrorResumeNext
屏幕不更新
Application.ScreenUpdating=False
Application.ScreenUpdating=True
警示为假
Application.DisplayAlerts=False
关掉文件不保存
Windows(oFile.Name).Activate
ActiveWorkbook.Closesavechanges:
=False
定义选中区域的坐标
dimx,y
x=Selection.Row()'行数
y=Selection.Column()'列数单元格所在的行数
ActiveCell.Row活‘动单元格所在的行数
ActiveCell.Column活‘动单元格所在的列数
通过使用行列编号,可用Cells属性来引用单个单元格。
该属性返回代表单个单元格的Range对象。
下例中,Cells(6,1)返回Sheet1上的单元格A6,然后将Value属性设置为10。
SubEnterValue()
Worksheets("Sheet1").Cells(6,1).Value=10
EndSub
因为可用变量替代编号,所以Cells属性非常适合于在单元格区域中循环,如下例所示
SubCycleThrough()
DimCounterAsInteger
ForCounter=1To20
Worksheets("Sheet1").Cells(Counter,3).Value=CounterNextCounter
EndSub
在命名区域中的单元格上循环
下例用ForEach...Next循环语句在命名区域中的每一个单元格上循环。
如果该区域中的任一单元格的值超过
limit的值,就将该单元格的颜色更改为黄色。
SubApplyColor()
ConstLimitAsInteger=25
ForEachcInRange("MyRange")
Ifc.Value>LimitThen
c」nterior.Colorlndex=27
EndIf
Nextc
EndSub
增^口一个workbooks,nameCarrier
Workbooks.Add
ActiveWorkbook.SaveAsFilename:
="D:
\BOMProduce\carrier.xls",FileFormat:
=_xlNormal,Password:
*',WriteResPassword:
="",ReadOnlyRecommended:
=False_,CreateBackup:
=False
增加一个表单,获取name
Sheets.Add
x=ActiveSheet.Name
Sheets(x).Select
插入一列
Range("E5").Select
Selection.EntireRow」nsert
插入一栏
Range("F6").Select
Selection.EntireColumn.Insert
向右移动一格
ActiveCell.Offset(0,-1).Select'当前单元格
当前单元格的值
ActiveCell.FormulaRICI=
UseRow
复制表单
Windows("spacebom.xls").Activate
Cells.Select
Selection.Copy
Windows("Bomsetup.xls").Activate
Sheets("Sheet2").Select
Cells.Select
ActiveSheet.Paste
Range("A1").Select
复制单元格
Windows("AkikoResourceBudgetPlan.xls").Activate
Range("BK71").Select
Application.CutCopyMode=False
Selection.Copy
Windows("Book1.xls").Activate
Sheets("Sheet2").Select
ActiveSheet.Paste
当前单元格整栏选择
ActiveCell.EntireColumn.Select、
整栏复制与粘贴
Columns("C:
C").Select
Selection.Copy
Selection.PasteSpecialPaste:
=xlPasteValues,Operation:
=xlNone,SkipBlanks_
:
=False,Transpose:
=False
两栏进行交换
Columns("L:
L").Select
Selection.Cut
Columns("N:
N").Select
Selection.InsertShift:
=xlToRight
Delete:
Rows("2:
2").Select
Selection.DeleteShift:
=xlUp
Range("B4").Select
Selection.EntireRow.Delete
每列从第k栏开始每5个一列进行排列:
Windows("bomsetup.xls").Activate
DimCounterAsInteger
ForCounter=2To1000
Cells(Counter,11).Select
IfActiveCell.Value=""Then
ActiveCell.Offset(1,0).Select
Else
ActiveCell.Offset(1,-5).Select
Selection.EntireRow」nsert
ActiveCell.Offset(-1,5).Select
Range(Selection,Selection.End(xlToRight)).Select
Selection.Cut
ActiveCell.Offset(1,-5).Select
ActiveSheet.Paste
EndIf
NextCounter
字体变色
Range("C3").Select
Selection.Font.Colorlndex=3
单元格变背景色
Selection」nterior.Colorlndex=3
字体变粗
Range("D4").Select
Selection.Font.Bold=True
在B栏中查找是否有0000后
Columns("B:
B").Select
Setfindxx=Selection.Find("0000")
IffindxxIsNothingThen
在B栏中查找0000后,向左移动一格
Columns("B:
B").Select
Selection.Find(What:
="0000",After:
=ActiveCell,LookIn:
=xlFormulas,LookAt_:
=xlPart,SearchOrder:
=xlByRows,SearchDirection:
=xlNext,MatchCase:
=_False,MatchByte:
=False,SearchFormat:
=False).Activate
ActiveCell.Offset(0,-1).Select
在c栏中找到N/a后用******替代
Columns("C:
C").Select
Selection.ReplaceWhat:
="n/a",Replacements"******",LookAt:
=xlPart,_
SearchOrder:
=xlByRows,MatchCase:
=False,SearchFormat:
=False,_
ReplaceFormat:
=False
排序
Cells.Select
Selection.SortKey1:
=Range("A2"),Order1:
=xlAscending,Key2:
=Range("C2")_
Order2:
=xlAscending,Header:
=xlYes,OrderCustom:
=1,MatchCase:
=False_
Orientation:
=xlTopToBottom,SortMethod:
=xlStroke,DataOption1:
=_
xlSortNormal,DataOption2:
=xlSortNormal
自动塞选
Cells.Select
Selection.AutoFilter
Selection.AutoFilterField:
=10取消赛选第10栏
'第10栏选择非#N/A
Selection.AutoFilterField:
=10,Criteria1:
="<>#N/A",Operator:
=xlAnd
自动运行Form
PrivateSubWorkbook_Open()
你的窗体.Show
EndSub
调整宽度
Columns("L:
L").EntireColumn.AutoFit
代表单元格区域"A1:
J10"
Range(Cells(1,1),Cells(10,10))代表单元格区域"A1:
J10"
区分颜色并删除
SubFilterColor()
DimUseRow,AC
UseRow=Cells.SpecialCells(xlCellTypeLastCell).Row
AC=ActiveCell.Column
Fori=1ToUseRow
IfCells(i,AC).lnterior.Colorlndex<>ActiveCell.lnterior.ColorlndexThen
Cells(i,AC).EntireRow.delete
EndIf
Next
EndIf
EndSub
依次打开选定数据夹中的xls文件
Subaa()
DimmyDialogAsFileDialog,oFileAsObject,strNameAsString,nAsInteger
DimFSOAsObject,myFolderAsObject,myFilesAsObject
Dimy
SetmyDialog=Application.FileDialog(msoFileDialogFolderPicker)
n=1
WithmyDialog
If.Show<>-1ThenExitSub
SetFSO=CreateObject("Scripting.FileSystemObject")
SetmyFolder=FSO.GetFolder(.lnitialFileName)
SetmyFiles=myFolder.Files
ForEachoFileInmyFiles
strName=UCase(oFile.Name)
strName=VBA.Right(strName,3)
IfstrName="XLS"Then
y=oFile.Name
Workbooks.openFilename:
=y
n=n+1
EndIf
Next
EndWith
EndSub
SUM变量引用
DimnRow1,nRow2AsInteger
DimnColAsInteger
nRow1=2
nRow2=11
nCol=4
Range("d12").Formula="=sum(d"&nRow1&":
d"&nRow2&")"
或者ActiveCell.FormulaR1C1="=SUM(R[-1]C:
R[-"&J&"]C)"
XIDirection可为XIDirection常量之一。
xlDown
xlToRight
xIToLeft
xIUp
示例
本示例选定包含单元格B4的区域中B列顶端的单元格。
Range("B4").End(xlUp).Select
本示例选定包含单元格B4的区域中第4行尾端的单元格。
Range("B4").End(xlToRight).Select
从单元格B4延伸至第四行最后一个包含数据的单元格。
Range("B4",Range("B4").End(xlToRight)).Select
引用单元格的值
Dimxxx
xxx=Workbooks("condition.xls").Worksheets("Sheet1").Range("A1").Value
加上格线
Subopenfileonebyone()
WithSelection.Borders(xlEdgeLeft)
丄ineStyle=xlContinuous
EndWith
WithSelection.Borders(xlEdgeTop)
丄ineStyle=xlContinuous
EndWith
WithSelection.Borders(xlEdgeBottom)
丄ineStyle=xlContinuous
EndWith
WithSelection.Borders(xlEdgeRight)
丄ineStyle=xlContinuous
EndWith
WithSelection.Borders(xllnsideVertical)
丄ineStyle=xlContinuous
EndWith
WithSelection.Borders(xlInsideHorizontal)
丄ineStyle=xlContinuous
EndWith
EndSub
依次打开指定活页夹中的文件
Subopenfileonebyone()
DimxAsObject
Dimf,fs,i,ofile
Setx=CreateObject("Scripting.FileSystemObject")
Setf=x.GetFolder("D:
\test")
Setfs=f.Files
ForEachofileInfs
Workbooks.OpenFilename:
=ofile
Next
EndSub
得到文件名
Dimgetlen,GetFile
getlen=Len(SrcFile.Name)'theelngthofthename
GetFile=Mid(ofile.Name,1,getlen-4)'deductthelastfourbytes
所在sheet最后一行
UseRow=Cells.SpecialCells(xlCellTypeLastCell).Row
DimiAsInteger
Dimmyarr
myarr=Array(opath1,opath2,opath3,opath4,opath5,dpath1,dpath2,dpath3,dpath4,dpath5)
Fori=0To4
mypath=myarr(i)'指定路径
Next
depath="D:
'指定路径。
myname=Dir(depath,vbDirectory)'找寻第一项。
DoWhilemyname<>""'开始循环。
'跳过当前的目录及上层目录。
Ifmyname<>"."Andmyname<>".."Then
dnum=dnum+1
Loop
显示C:
\目录下的名称。
MyPath="c:
\"'指定路径。
MyName=Dir(MyPath,vbDirectory)'找寻第一项。
DoWhileMyName<>""'开始循环。
'跳过当前的目录及上层目录。
IfMyName<>"."AndMyName<>".."Then
'使用位比较来确定MyName代表一目录。
If(GetAttr(MyPath&MyName)AndvbDirectory)=vbDirectoryThen
如果它是一个目录,将其名称显示岀来。
查找下一个目录
Debug.PrintMyName
EndIf
EndIf
MyName=Dir
Loop
Sub统计显示所浏览的文件夹中某类文件的数量及文件名()
Application.DisplayAlerts=False
Forzzzzz=1To5
jjjjj=Workbooks("Book4").Sheets
(1).Cells(zzzzz,1)
SetX=CreateObject("Scripting.FileSystemObject")
SetF=X.GetFolder(jjjjj)
SetFS=F.subfolders
ForEachofileInFS
i=i+1
Cells(i,1)=ofile&"\ZW"
Next
Forj=1Toi
Sheets.Add
SetX=CreateObject("Scripting.FileSystemObject")
eee=Sheets("sheet1").Cells(j,1)
SetF=X.GetFolder(eee)
SetFS=F.Files
ForEachofileInFS
y=y+1
Cells(y,1)=ofile.Name
Nexty=0Next
Fork=1Toi
Sheets(k).Select
Cells(1,2).Select
Cells(1,2)=Application.CountA(Range(Cells(1,1),Cells(5000,1)))
Cells(1,3)=Cells(Cells(1,2),1)
Cells(1,4)=Left(Right(Cells(1,3),8),4)-Cells(1,2)
IfCells(1,4)<>0ThenActiveSheet.Tab.Colorlndex=3
Z=Z+Cells(1,4)
Next
MsgBoxZ
selectioon.Copy
Forccccc=1Toi
Sheets
(1).Delete
Next
Sheets
(1).Cells.Clear
i=0
Z=0
Next
EndSub
添加图表
xxx=ActiveSheet.Shapes.AddChart.Name
ActiveSheet.ChartObjects(xxx).Select
ActiveChart.SetSourceDataSource:
=Range("A3:
F16")
COPY—栏到多栏
Rows
(1).CopyDestination:
=.Rows(""&SPfileexistcount+1&":
"&SPfileexistcount+Bomrtqty
&"")
Fori=1ToActiveSheet.ChartObjects.Count
MsgBoxActiveSheet.ChartObjects(i).Name
Next
ActiveSheet.ChartObjects
(1).Activate
ActiveSheet.ChartObjects("Chart1").Activate
定制模块行为
(I)OptionExplicit'强制对模块内所有变量进行声明
OptionPrivateModule'标记模块为私有,仅对同一工程中其它模块有用,在宏对话框中不显示
OptionCompareText'字符串不区分大小写
OptionBase1'指定数组的第一个下标为1
⑵OnErrorResumeNext'忽略错误继续执行VBA代码,避免岀现错误消息
⑶OnErrorGoToErrorHandler'当错误发生时跳转到过程中的某个位置
(4)OnErrorGoTo0'恢复正常的错误提示
(5)Application.DisplayAlerts=False'在程序执行过程中使岀现的警告框不显示
⑹Application.ScreenUpdating=False'关闭屏幕刷新
Application.ScreenUpdating=True'打开屏幕刷新
⑺Application.Enable.CancelKey=xlDisabled'禁用Ctrl+Break中止宏运行的功能
工作簿
(8)Workbooks.Add()'创建一个新的工作簿
(9)Workbooks(“book1.xls”).Actiea激活名为book1的工作簿
(10)ThisWorkbook.Save'保存工作簿
(II)ThisWorkbook.close'关闭当前工作簿
(12)ActiveWorkbook.Sheets.Count'获取活动工作薄中工作表数
(13)ActiveWorkbook.name'返回活动工作薄的名称
(14)ThisWorkbook.Name返回当前工作簿名称
ThisWorkbook.FullName返回当前工作簿路径和名称
(15)ActiveWindow.EnableResize=False禁止调整活动工作簿的大小
(16)Application.Window.ArrangexlArrangeStyleTiled将工作簿以平铺方式排列
(17)ActiveWorkbook.WindowState=xlMaximized将当前工作簿最大化
DimFound,MyObject,MyCollection
Found=False'设置变量初始值。
ForEachMyObjectInMyCollection'对每个成员作一次迭代。
IfMyObject.Text="Hello"Then'如果Text属性值等于“Hello
Found=True'将变量Found的值设成True。
ExitFor'退岀循环。
EndIf
Next
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VBA 语句 汇总