VBA语句汇总.docx - 冰点文库

资源描述

VBA语句汇总.docx

《VBA语句汇总.docx》由会员分享，可在线阅读，更多相关《VBA语句汇总.docx（16页珍藏版）》请在冰点文库上搜索。

VBA语句汇总.docx

VBA语句汇总

VBA-语句（yǔjù）汇总

程序（chéngxù）错误继续执行

OnErrorResumeNext

屏幕（píngmù）不更新

Application.ScreenUpdating = False

Application.ScreenUpdating = True

警示（jǐnɡshì）为假

Application.DisplayAlerts=False

关掉文件（wénjiàn）不保存

Windows（oFile.Name）.Activate

ActiveWorkbook.Closesavechanges:

=False

定义（dìngyì）选中区域的坐标

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=Counter

NextCounter

EndSub

在命名区域（qūyù）中的单元格上循环

下例用ForEach...Next循环语句（yǔjù）在命名区域中的每一个单元格上循环。

如果该区域中的任一单元格的值超过limit的值，就将该单元格的颜色（yánsè）更改为黄色。

SubApplyColor（）

ConstLimitAsInteger=25

ForEachcInRange（"MyRange"）

Ifc.Value>LimitThen

c.Interior.ColorIndex=27

EndIf

Nextc

EndSub

增加（zēngjiā）一个workbooks,nameCarrier

Workbooks.Add

ActiveWorkbook.SaveAsFilename:

="D:

\BOMProduce\carrier.xls",FileFormat:

xlNormal,Password:

="",WriteResPassword:

="",ReadOnlyRecommended:

=False_

CreateBackup:

=False

增加一个（yīɡè）表单，获取name

Sheets.Add

x=ActiveSheet.Name

Sheets（x）.Select

插入一列

Range（"E5"）.Select

Selection.EntireRow.Insert

插入一栏

Range（"F6"）.Select

Selection.EntireColumn.Insert

向右移动一格

ActiveCell.Offset（0,-1）.Select'当前单元格

当前（dāngqián）单元格的值

ActiveCell.FormulaR1C1=“UseRow”

复制（fùzhì）表单

Windows（"spacebom.xls"）.Activate

Cells.Select

Selection.Copy

Windows（"Bomsetup.xls"）.Activate

Sheets（"Sheet2"）.Select

Cells.Select

ActiveSheet.Paste

Range（"A1"）.Select

复制（fùzhì）单元格

Windows（"AkikoResourceBudgetPlan.xls"）.Activate

Range（"BK71"）.Select

Application.CutCopyMode=False

Selection.Copy

Windows（"Book1.xls"）.Activate

Sheets（"Sheet2"）.Select

ActiveSheet.Paste

当前（dāngqián）单元格整栏选择

ActiveCell.EntireColumn.Select、

整栏复制（fùzhì）与粘贴

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栏开始（kāishǐ）每5个一列进行（jìnxíng）排列：

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.Insert

ActiveCell.Offset（-1,5）.Select

Range（Selection,Selection.End（xlToRight））.Select

Selection.Cut

ActiveCell.Offset（1,-5）.Select

ActiveSheet.Paste

EndIf

NextCounter

字体（zìtǐ）变色

Range（"C3"）.Select

Selection.Font.ColorIndex=3

单元格变背景色

Selection.Interior.ColorIndex=3

字体（zìtǐ）变粗

Range（"D4"）.Select

Selection.Font.Bold=True

在B栏中查找（cházhǎo）是否有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后用******替代（tìdài）

Columns（"C:

C"）.Select

Selection.ReplaceWhat:

="n/a",Replacement:

="******",LookAt:

=xlPart,_

SearchOrder:

=xlByRows,MatchCase:

=False,SearchFormat:

=False,_

ReplaceFormat:

=False

排序（páixù）

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

自动（zìdòng）塞选

Cells.Select

Selection.AutoFilter

Selection.AutoFilterField:

=10‘取消（qǔxiāo）赛选第10栏

Selection.AutoFilterField:

=10,Criteria1:

="<>#N/A",Operator:

=xlAnd‘第10栏选择（xuǎnzé）非#N/A

自动运行Form

PrivateSubWorkbook_Open（）

你的窗体.Show

EndSub

调整宽度

Columns（"L:

L"）.EntireColumn.AutoFit

代表单元格区域"A1:

J10"

Range（Cells（1,1）,Cells（10,10））代表单元格区域"A1:

J10"

区分颜色并删除

Sub FilterColor（）

Dim UseRow, AC

UseRow = Cells.SpecialCells（xlCellTypeLastCell）.Row

AC = ActiveCell.Column

For i = 1 To UseRow

If Cells（i, AC）.Interior.ColorIndex <> ActiveCell.Interior.ColorIndex Then

Cells（i, AC）.EntireRow.delete

End If

End Sub

依次（yīcì）打开选定（xuǎndìnɡ）数据夹中的xls文件（wénjiàn）

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（.InitialFileName）

SetmyFiles=myFolder.Files

ForEachoFileInmyFiles

strName=UCase（oFile.Name）

strName=VBA.Right（strName,3）

IfstrName="XLS"Then

y=oFile.Name

Workbooks.openFilename:

n=n+1

EndIf

EndWith

EndSub

SUM变量（biànliàng）引用

DimnRow1,nRow2AsInteger

DimnColAsInteger

nRow1=2

nRow2=11

nCol=4

Range（"d12"）.Formula="=sum（d"&nRow1&":

d"&nRow2&"）"

或者（huòzhě）ActiveCell.FormulaR1C1="=SUM（R[-1]C:

R[-"&J&"]C）"

XlDirection可为XlDirection常量（chángliàng）之一。

xlDown

xlToRight

xlToLeft

xlUp

示例（shìlì）

本示例（shìlì）选定包含单元格B4的区域（qūyù）中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）

.LineStyle=xlContinuous

EndWith

WithSelection.Borders（xlEdgeTop）

.LineStyle=xlContinuous

EndWith

WithSelection.Borders（xlEdgeBottom）

.LineStyle=xlContinuous

EndWith

WithSelection.Borders（xlEdgeRight）

.LineStyle=xlContinuous

EndWith

WithSelection.Borders（xlInsideVertical）

.LineStyle=xlContinuous

EndWith

WithSelection.Borders（xlInsideHorizontal）

.LineStyle=xlContinuous

EndWith

EndSub

依次（yīcì）打开指定（zhǐdìng）活页夹中的文件（wénjiàn）

Subopenfileonebyone（）

DimxAsObject

Dimf,fs,i,ofile

Setx=CreateObject（"Scripting.FileSystemObject"）

Setf=x.GetFolder（"D:

\test"）

Setfs=f.Files

ForEachofileInfs

Workbooks.OpenFilename:

=ofile

EndSub

得到（dédào）文件名

Dimgetlen,GetFile

getlen=Len（SrcFile.Name）’thelengthofthename

GetFile=Mid（ofile.Name,1,getlen-4）‘deductthelastfourbytes

所在（suǒzài）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）'指定路径。

depath=“D:

\”'指定（zhǐdìng）路径。

myname=Dir（depath,vbDirectory）'找寻（zhǎoxún）第一项。

DoWhilemyname<>""'开始（kāishǐ）循环。

Ifmyname<>"."Andmyname<>".."Then

dnum=dnum+1

EndIf

myname=Dir'查找下一个（yīɡè）目录。

Loop

显示C:

\目录下的名称。

MyPath="c:

\"'指定路径。

MyName=Dir（MyPath,vbDirectory）'找寻第一项。

DoWhileMyName<>""'开始循环。

IfMyName<>"."AndMyName<>".."Then

'使用位比较来确定MyName代表一目录。

If（GetAttr（MyPath&MyName）AndvbDirectory）=vbDirectoryThen

Debug.PrintMyName'如果它是一个目录，将其名称显示出来。

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"

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

y=0

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.ColorIndex=3

Z=Z+Cells（1,4）

MsgBoxZ

selectioon.Copy

Forccccc=1Toi

Sheets

（1）.Delete

Sheets

（1）.Cells.Clear

i=0

Z=0

EndSub

添加（tiānjiā）图表

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

ActiveSheet.ChartObjects

（1）.Activate

ActiveSheet.ChartObjects（"Chart1"）.Activate

==============

定制（dìnɡzhì）模块行为

（1）OptionExplicit'强制（qiángzhì）对模块内所有变量进行声明

OptionPrivateModule'标记（biāojì）模块为私有，仅对同一工程中其它模块有用，在宏对话框中不显示

OptionCompareText'字符串不区分（qūfēn）大小写

OptionBase1'指定数组的第一个下标为1

（2）OnErrorResumeNext'忽略错误继续执行VBA代码,避免出现错误消息

（3）OnErrorGoToErrorHandler'当错误发生时跳转到过程中的某个位置

（4）OnErrorGoTo0'恢复正常的错误提示

（5）Application.DisplayAlerts=False'在程序执行过程中使出现的警告框不显示

（6）Application.ScreenUpdating=False'关闭屏幕刷新

Application.ScreenUpdating=True'打开屏幕刷新

（7）Application.Enable.CancelKey=xlDisabled'禁用Ctrl+Break中止宏运行的功能

工作簿

（8）Workbooks.Add（）'创建一个新的工作簿

（9）Workbooks（“book1.xls”）.Activate'激活名为book1的工作簿

（10）ThisWorkbook.Save'保存工作簿

（11）ThisWorkbook.close'关闭（guānbì）当前工作簿

（12

展开阅读全文