VBA语句汇总Word文档格式.docx
《VBA语句汇总Word文档格式.docx》由会员分享，可在线阅读，更多相关《VBA语句汇总Word文档格式.docx（16页珍藏版）》请在冰点文库上搜索。
）中的单元格上循环
下例用ForEach...Next循环语句（yǔjù
）在命名区域中的每一个单元格上循环。
如果该区域中的任一单元格的值超过limit的值，就将该单元格的颜色（yá
nsè
）更改为黄色。
SubApplyColor（）
ConstLimitAsInteger=25
ForEachcInRange（"
MyRange"
）
Ifc.Value>
LimitThen
c.Interior.ColorIndex=27
EndIf
Nextc
增加（zēngjiā）一个workbooks,nameCarrier
Workbooks.Add
ActiveWorkbook.SaveAsFilename:
="
D:
\BOMProduce\carrier.xls"
FileFormat:
=_
xlNormal,Password:
"
WriteResPassword:
ReadOnlyRecommended:
=False_
CreateBackup:
增加一个（yīɡè
）表单，获取name
Sheets.Add
x=ActiveSheet.Name
Sheets（x）.Select
插入一列
Range（"
E5"
）.Select
Selection.EntireRow.Insert
插入一栏
F6"
Selection.EntireColumn.Insert
向右移动一格
ActiveCell.Offset（0,-1）.Select'
当前单元格
当前（dāngqiá
n）单元格的值
ActiveCell.FormulaR1C1=“UseRow”
复制（fù
zhì
）表单
Windows（"
spacebom.xls"
）.Activate
Cells.Select
Selection.Copy
Bomsetup.xls"
Sheets（"
Sheet2"
ActiveSheet.Paste
A1"
）单元格
AkikoResourceBudgetPlan.xls"
BK71"
Application.CutCopyMode=False
Book1.xls"
n）单元格整栏选择
ActiveCell.EntireColumn.Select、
整栏复制（fù
）与粘贴
Columns（"
C:
C"
Selection.PasteSpecialPaste:
=xlPasteValues,Operation:
=xlNone,SkipBlanks_
:
=False,Transpose:
两栏进行交换
L:
L"
Selection.Cut
Columns（"
N:
N"
Selection.InsertShift:
=xlToRight
Delete:
Rows（"
2:
2"
Selection.DeleteShift:
=xlUp
Range（"
B4"
Selection.EntireRow.Delete
每列从第k栏开始（kāishǐ）每5个一列进行（jì
nxí
ng）排列：
bomsetup.xls"
DimCounterAsInteger
ForCounter=2To1000
Cells（Counter,11）.Select
IfActiveCell.Value="
Then
ActiveCell.Offset（1,0）.Select
Else
ActiveCell.Offset（1,-5）.Select
ActiveCell.Offset（-1,5）.Select
Range（Selection,Selection.End（xlToRight））.Select
EndIf
NextCounter
字体（zì
tǐ）变色
C3"
Selection.Font.ColorIndex=3
单元格变背景色
Selection.Interior.ColorIndex=3
tǐ）变粗
D4"
Selection.Font.Bold=True
在B栏中查找（chá
zhǎo）是否有0000后
B:
B"
Setfindxx=Selection.Find（"
0000"
）
IffindxxIsNothingThen
在B栏中查找0000后，向左移动一格
Selection.Find（What:
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）
Selection.ReplaceWhat:
n/a"
Replacement:
******"
LookAt:
=xlPart,_
SearchOrder:
=xlByRows,MatchCase:
=False,_
ReplaceFormat:
排序（pá
ixù
Cells.Select
Selection.SortKey1:
=Range（"
A2"
）,Order1:
=xlAscending,Key2:
C2"
）_
Order2:
=xlAscending,Header:
=xlYes,OrderCustom:
=1,MatchCase:
Orientation:
=xlTopToBottom,SortMethod:
=xlStroke,DataOption1:
xlSortNormal,DataOption2:
=xlSortNormal
自动（zì
dò
ng）塞选
Selection.AutoFilter
Selection.AutoFilterField:
=10‘取消（qǔxiāo）赛选第10栏
=10,Criteria1:
<
>
#N/A"
Operator:
=xlAnd‘第10栏选择（xuǎnzé
）非#N/A
自动运行Form
PrivateSubWorkbook_Open（）
你的窗体.Show
调整宽度
）.EntireColumn.AutoFit
代表单元格区域"
A1:
J10"
Range（Cells（1,1）,Cells（10,10））代表单元格区域"
区分颜色并删除
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
AC）.EntireRow.delete
End
If
Next
Sub
依次（yīcì
）打开选定（xuǎndì
nɡ）数据夹中的xls文件（wé
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"
y=oFile.Name
Workbooks.openFilename:
=y
n=n+1
EndIf
Next
EndWith
SUM变量（bià
nlià
ng）引用
DimnRow1,nRow2AsInteger
DimnColAsInteger
nRow1=2
nRow2=11
nCol=4
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ì
）选定包含单元格B4的区域（qūyù
）中B列顶端的单元格。
）.End（xlUp）.Select
本示例选定包含单元格B4的区域中第4行尾端的单元格。
）.End（xlToRight）.Select
从单元格B4延伸至第四行最后一个包含数据的单元格。
Range（"
）.End（xlToRight））.Select
引用单元格的值
Dimxxx
xxx=Workbooks（"
condition.xls"
）.Worksheets（"
）.Range（"
）.Value
加上格线
Subopenfileonebyone（）
WithSelection.Borders（xlEdgeLeft）
.LineStyle=xlContinuous
EndWith
WithSelection.Borders（xlEdgeTop）
WithSelection.Borders（xlEdgeBottom）
WithSelection.Borders（xlEdgeRight）
WithSelection.Borders（xlInsideVertical）
WithSelection.Borders（xlInsideHorizontal）
EndSub
）打开指定（zhǐdì
ng）活页夹中的文件（wé
DimxAsObject
Dimf,fs,i,ofile
Setx=CreateObject（"
Setf=x.GetFolder（"
\test"
Setfs=f.Files
ForEachofileInfs
Workbooks.OpenFilename:
=ofile
Next
得到（dé
dà
o）文件名
Dimgetlen,GetFile
getlen=Len（SrcFile.Name）’thelengthofthename
GetFile=Mid（ofile.Name,1,getlen-4）‘deductthelastfourbytes
所在（suǒzà
i）sheet最后一行
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ǐ）循环。
跳过当前的目录（mù
lù
）及上层目录。
Ifmyname<
."
Andmyname<
.."
dnum=dnum+1
myname=Dir'
查找下一个（yīɡè
）目录。
Loop
显示C:
\目录下的名称。
MyPath="
c:
\"
MyName=Dir（MyPath,vbDirectory）'
找寻第一项。
DoWhileMyName<
开始循环。
跳过当前的目录及上层目录。
IfMyName<
AndMyName<
使用位比较来确定MyName代表一目录。
If（GetAttr（MyPath&
MyName）AndvbDirectory）=vbDirectoryThen
Debug.PrintMyName'
如果它是一个目录，将其名称显示出来。
MyName=Dir'
查找下一个目录。
Sub统计显示所浏览的文件夹中某类文件的数量及文件名（）
Forzzzzz=1To5
jjjjj=Workbooks（"
Book4"
）.Sheets
（1）.Cells（zzzzz,1）
SetX=CreateObject（"
SetF=X.GetFolder（jjjjj）
SetFS=F.subfolders
ForEachofileInFS
i=i+1
Cells（i,1）=ofile&
\ZW"
Forj=1Toi
eee=Sheets（"
sheet1"
）.Cells（j,1）
SetF=X.GetFolder（eee）
SetFS=F.Files
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
添加（tiānjiā）图表
xxx=ActiveSheet.Shapes.AddChart.Name
ActiveSheet.ChartObjects（xxx）.Select
ActiveChart.SetSourceDataSource:
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"
==============
定制（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
升级会员 