VBA语句汇总Word文档下载推荐.docx

上传人:b****6 文档编号:18748814 上传时间:2023-01-01 格式:DOCX 页数:13 大小:23.59KB
下载 相关 举报
VBA语句汇总Word文档下载推荐.docx_第1页
第1页 / 共13页
VBA语句汇总Word文档下载推荐.docx_第2页
第2页 / 共13页
VBA语句汇总Word文档下载推荐.docx_第3页
第3页 / 共13页
VBA语句汇总Word文档下载推荐.docx_第4页
第4页 / 共13页
VBA语句汇总Word文档下载推荐.docx_第5页
第5页 / 共13页
点击查看更多>>
下载资源
资源描述

VBA语句汇总Word文档下载推荐.docx

《VBA语句汇总Word文档下载推荐.docx》由会员分享,可在线阅读,更多相关《VBA语句汇总Word文档下载推荐.docx(13页珍藏版)》请在冰豆网上搜索。

VBA语句汇总Word文档下载推荐.docx

EndIf

Nextc

增^口一个workbooks,nameCarrier

Workbooks.Add

ActiveWorkbook.SaveAsFilename:

="

D:

\BOMProduce\carrier.xls"

FileFormat:

=_xlNormal,Password:

*'

WriteResPassword:

"

ReadOnlyRecommended:

=False_,CreateBackup:

增加一个表单,获取name

Sheets.Add

x=ActiveSheet.Name

Sheets(x).Select

插入一列

Range("

E5"

).Select

Selection.EntireRow」nsert

插入一栏

F6"

Selection.EntireColumn.Insert

向右移动一格

ActiveCell.Offset(0,-1).Select'

当前单元格

当前单元格的值

 

ActiveCell.FormulaRICI=

UseRow

复制表单

Windows("

spacebom.xls"

).Activate

Cells.Select

Selection.Copy

Bomsetup.xls"

Sheets("

Sheet2"

ActiveSheet.Paste

A1"

复制单元格

AkikoResourceBudgetPlan.xls"

BK71"

Application.CutCopyMode=False

Book1.xls"

当前单元格整栏选择

ActiveCell.EntireColumn.Select、

整栏复制与粘贴

Columns("

C:

C"

Selection.PasteSpecialPaste:

=xlPasteValues,Operation:

=xlNone,SkipBlanks_

:

=False,Transpose:

两栏进行交换

L:

L"

Selection.Cut

N:

N"

Selection.InsertShift:

=xlToRight

Delete:

Rows("

2:

2"

Selection.DeleteShift:

=xlUp

B4"

Selection.EntireRow.Delete

每列从第k栏开始每5个一列进行排列:

bomsetup.xls"

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

NextCounter

字体变色

C3"

Selection.Font.Colorlndex=3

单元格变背景色

Selection」nterior.Colorlndex=3

字体变粗

D4"

Selection.Font.Bold=True

在B栏中查找是否有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后用******替代

Selection.ReplaceWhat:

n/a"

Replacements"

******"

LookAt:

=xlPart,_

SearchOrder:

=xlByRows,MatchCase:

=False,_

ReplaceFormat:

排序

Selection.SortKey1:

=Range("

A2"

),Order1:

=xlAscending,Key2:

C2"

)_

Order2:

=xlAscending,Header:

=xlYes,OrderCustom:

=1,MatchCase:

=False_

Orientation:

=xlTopToBottom,SortMethod:

=xlStroke,DataOption1:

=_

xlSortNormal,DataOption2:

=xlSortNormal

自动塞选

Selection.AutoFilter

Selection.AutoFilterField:

=10取消赛选第10栏

'

第10栏选择非#N/A

=10,Criteria1:

<

>

#N/A"

Operator:

=xlAnd

自动运行Form

PrivateSubWorkbook_Open()

你的窗体.Show

调整宽度

).EntireColumn.AutoFit

代表单元格区域"

A1:

J10"

Range(Cells(1,1),Cells(10,10))代表单元格区域"

区分颜色并删除

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

Next

依次打开选定数据夹中的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

EndWith

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列顶端的单元格。

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

丄ineStyle=xlContinuous

WithSelection.Borders(xlEdgeTop)

WithSelection.Borders(xlEdgeBottom)

WithSelection.Borders(xlEdgeRight)

WithSelection.Borders(xllnsideVertical)

WithSelection.Borders(xlInsideHorizontal)

依次打开指定活页夹中的文件

DimxAsObject

Dimf,fs,i,ofile

Setx=CreateObject("

Setf=x.GetFolder("

\test"

Setfs=f.Files

ForEachofileInfs

Workbooks.OpenFilename:

=ofile

得到文件名

Dimgetlen,GetFile

getlen=Len(SrcFile.Name)'

theelngthofthename

GetFile=Mid(ofile.Name,1,getlen-4)'

deductthelastfourbytes

所在sheet最后一行

DimiAsInteger

Dimmyarr

myarr=Array(opath1,opath2,opath3,opath4,opath5,dpath1,dpath2,dpath3,dpath4,dpath5)

Fori=0To4

mypath=myarr(i)'

指定路径

depath="

'

指定路径。

myname=Dir(depath,vbDirectory)'

找寻第一项。

DoWhilemyname<

开始循环。

跳过当前的目录及上层目录。

Ifmyname<

."

Andmyname<

.."

dnum=dnum+1

Loop

显示C:

\目录下的名称。

MyPath="

c:

\"

MyName=Dir(MyPath,vbDirectory)'

DoWhileMyName<

IfMyName<

AndMyName<

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

If(GetAttr(MyPath&

MyName)AndvbDirectory)=vbDirectoryThen

如果它是一个目录,将其名称显示岀来。

查找下一个目录

Debug.PrintMyName

MyName=Dir

Sub统计显示所浏览的文件夹中某类文件的数量及文件名()

Application.DisplayAlerts=False

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

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)

MsgBoxZ

selectioon.Copy

Forccccc=1Toi

Sheets

(1).Delete

Sheets

(1).Cells.Clear

i=0

Z=0

添加图表

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"

定制模块行为

(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'

退岀循环。

展开阅读全文
相关资源
猜你喜欢
相关搜索

当前位置:首页 > 自然科学

copyright@ 2008-2022 冰豆网网站版权所有

经营许可证编号:鄂ICP备2022015515号-1