Excel VBA常用代码总结1讲解学习文档格式.docx
- 文档编号:361838
- 上传时间:2023-04-28
- 格式:DOCX
- 页数:23
- 大小:57.85KB
Excel VBA常用代码总结1讲解学习文档格式.docx
《Excel VBA常用代码总结1讲解学习文档格式.docx》由会员分享,可在线阅读,更多相关《Excel VBA常用代码总结1讲解学习文档格式.docx(23页珍藏版)》请在冰点文库上搜索。
g15"
由于区域A1:
E10和F11:
G15没有公共区域,将最终选择F11:
G15,并激活F11单元格。
∙获得文档的路径和文件名
ActiveWorkbook.Path '
路徑
ActiveWorkbook.Name '
名稱
ActiveWorkbook.FullName '
路徑+名稱
或将ActiveWorkbook换成thisworkbook
∙隐藏文档
Application.Visible=False
∙禁止屏幕更新
Application.ScreenUpdating=False
∙禁止显示提示和警告消息
Application.DisplayAlerts=False
∙文件夹做成
strPath="
C:
\temp\"
MkDirstrPath
∙状态栏文字表示
Application.StatusBar="
计算中"
∙双击单元格内容变换
PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)
If(Target.Cells.Row>
=5AndTarget.Cells.Row<
=8)Then
IfTarget.Cells.Value="
●"
Then
Target.Cells.Value="
"
Else
EndIf
Cancel=True
EndSub
∙文件夹选择框方法1
SetobjShell=CreateObject("
Shell.Application"
SetobjFolder=objShell.BrowseForFolder(0,"
文件"
0,0)
IfNotobjFolderIsNothing
Thenpath=objFolder.self.Path&
"
\"
endif
SetobjFolder=Nothing
SetobjShell=Nothing
∙文件夹选择框方法2(推荐)
PublicFunctionChooseFolder()AsString
DimdlgOpenAsFileDialog
SetdlgOpen=Application.FileDialog(msoFileDialogFolderPicker)
WithdlgOpen
.InitialFileName=ThisWorkbook.path&
If.Show=-1Then
ChooseFolder=.SelectedItems
(1)
EndWith
SetdlgOpen=Nothing
EndFunction
使用方法例:
DimpathAsString
path=ChooseFolder()
Ifpath<
>
MsgBox"
openfolder"
EndIf
∙文件选择框方法
PublicFunctionChooseOneFile(OptionalTitleStrAsString="
Pleasechooseafile"
OptionalTypesDecAsString="
*.*"
OptionalExtenAsString="
)AsString
SetdlgOpen=Application.FileDialog(msoFileDialogFilePicker)
.Title=TitleStr
.Filters.Clear
.Filters.AddTypesDec,Exten
.AllowMultiSelect=False
.InitialFileName=ThisWorkbook.Path
'
.AllowMultiSelect=True
ForEachvrtSelectedItemIn.SelectedItems
Pathname:
&
vrtSelectedItem
NextvrtSelectedItem
ChooseOneFile=.SelectedItems
(1)
∙某列到关键字为止循环方法1(假设关键字是end)
SetCurrentCell=Range("
DoWhileCurrentCell.Value<
end"
……
SetCurrentCell=CurrentCell.Offset(1,0)
Loop
∙某列到关键字为止循环方法2(假设关键字是空字符串)
i=StartRow
DoWhileCells(i,1)<
i=i+1
∙"
ForEach...Next循环(知道确切边界)
ForEachcInWorksheets("
).Range("
A1:
D10"
).Cells
IfAbs(c.Value)<
0.01Thenc.Value=0
Next
ForEach...Next循环(不知道确切边界),在活动单元格周围的区域内循环
ForEachcInActiveCell.CurrentRegion.Cells
IfAbs(c.Value)<
∙某列有数据的最末行的行数的取得(中间不能有空行)
lonRow=1
DoWhileTrim(Cells(lonRow,2).Value)<
lonRow=lonRow+1
lonRow11=lonRow11-1
∙A列有数据的最末行的行数的取得另一种方法
A65536"
).End(xlUp).Row
∙将文字复制到剪贴板
DimMyDataAsDataObject
SetMyData=NewDataObject
MyData.SetTextRange("
).Value
MyData.PutInClipboard
∙取得路径中的文件名
PrivateFunctionGetFileName(ByValsAsString)
Dimsname()AsString
sname=Split(s,"
GetFileName=sname(UBound(sname))
EndFunction
∙取得路径中的路径名
PrivateFunctionGetPathName(ByValsAsString)
intFileNameStart=InStrRev(s,"
GetPathName=Mid(s,1,intFileNameStart)
∙由模板sheet拷贝做成一个新的sheet
ThisWorkbook.Worksheets("
template"
).CopyAfter:
=ThisWorkbook.Worksheets(Sheets.Count)
Setdoc_s=ThisWorkbook.Worksheets(Sheets.Count)
doc_s.Name="
newsheetname"
Format(Now,"
yyyyMMddhhmmss"
∙选中当列的最后一个有内容的单元格(中间不能有空行)
删除B3开始到B列最后一个有内容的单元格为止的所有内容
B3"
Range(Selection,Selection.End(xlDown)).Select
Selection.ClearContents
∙常量定义
PrivateConstStartRowAsInteger=3
∙判断sheet是否存在
PrivateFunctionIsWorksheet(ByValstrSeetNameAsString)AsBoolean
OnErrorGoToErrHandle
DimblnRetAsBoolean
blnRet=IsNull(Worksheets(strSeetName))
IsWorksheet=True
ExitFunction
ErrHandle:
IsWorksheet=False
∙向单元格中写入公式
D6"
).Formula="
=SUM(D2:
D5)"
∙引用命名单元格区域
MyBook.xls!
MyRange"
[Report.xls]Sheet1!
Sales"
∙选定命名的单元格区域
Application.GotoReference:
="
或者
worksheets("
sheetname"
).range("
rangename"
).select
∙使用Dictionary
使用Dictionary需要添加参照MicrosoftScriptingRuntime
DimdicAsNewDictionary
dic.Add"
Table"
"
Cards"
前面是Key后面是Value
Serial"
serialno"
Number"
surface"
MsgBoxdic.Item("
)'
由Key取得Value
dic.Exists("
判断某Key是否存在
∙将EXCEL表格中的两列表格插入到一个Dictionary中
函数:
在ws工作表中,从iStartRow行开始到没有数据为止,把iKeyCol列和iKeyCol右一列插入到一个字典中,并返回字典。
PublicFunctionSetDic(wsAsWorksheet,iStartRow,iKeyColAsInteger)AsDictionary
DimdicAsNewDictionary
DimiAsInteger
i=iStartRow
DoUntilws.Cells(i,iRuleCol).Value="
IfNotdic.Exists(ws.Cells(i,iKeyCol).Value)Then
dic.Addws.Cells(i,iKeyCol).Value,ws.Cells(i,iKeyCol+1).Value
i=i+1
Loop
SetSetDic=dic
∙判断文件夹或文件是否存在
文件夹
IfDir("
\aaa"
vbDirectory)="
Then
MkDir"
EndIf
文件
\aaa\1.txt"
)="
msgbox"
文件C:
\aaa\1.txt不存在"
endif
∙一次注释多行
视图---工具栏---编辑
调出编辑工具栏,工具栏上有个“设置注释块”和“解除注释快”
∙打开文件并将文件赋予到第一个参数wb中
注意,这里的path是文件的完整路径,包括文件名。
PublicFunctionOpenWorkBook(wbAsWorkbook,pathAsString)AsBoolean
OnErrorGoToErr
OpenWorkBook=True
DimisWbOpenedAsBoolean
isWbOpened=False
DimfileNameAsString
fileName=GetFileName(path)
checkfileisopenedoreither
DimwbTempAsWorkbook
ForEachwbTempInWorkbooks
IfwbTemp.Name=fileNameThenisWbOpened=True
Next
openfile
IfisWbOpened=FalseThen
Workbooks.Openpath
Setwb=Workbooks(fileName)
Err:
OpenWorkBook=False
∙打开一个文件,并将文件赋予到wb中,将文件的sheet页赋予到ws中的完整代码。
(用到了上面的函数)
IfOpenWorkBook(wb,path&
filename"
)=FalseThen
openfileerror."
GoToErr
wb.Activate
Setws=wb.Worksheets("
)
∙打开一个不知道确切名字的文件(文件名中含有serachname),并将文件赋予到wb中,将文件的sheet页赋予到ws中的完整代码。
用到了上上面的函数OpenWorkBook
IfOpenCompanyFile(wb,path,"
searchname"
直接使用的函数OpenCompanyFile
FunctionOpenCompanyFile(wbComAsWorkbook,strPathAsString,strFileNameAsString)AsBoolean
DimfsAsVariant
fs=Dir(strPath&
\*.xls"
seachfiles
OpenCompanyFile=False
DoWhilefs<
IfInStr(1,fs,strFileName)>
0Then'
filenamematch
IfOpenWorkBook(wbCom,strPath&
fs)=FalseThen'
ExitDo
OpenCompanyFile=True
fs=Dir
∙数字转字母(如1转成A,2转成B)和字母转数字
Chr(i+64)
比如i=1的时候,Chr(i+64)=A
Asc(i-64)
比如i=A的时候,Asc(i-64)=1
∙复选框总开关实现。
假如有10个子checkbox1~checkbox10,还有一个总开关checkbox11,让checkbox11控制1~10的选择和非选择。
PrivateSubCheckBox11_Click()
DimchbAsVariant
IfMe.CheckBox11.Value=TrueThen
ForEachchbInActiveSheet.OLEObjects
Ifchb.NameLike"
CheckBox*"
Andchb.Name<
CheckBox11"
chb.Object.Value=True
Else
chb.Object.Value=False
∙修改B6单元格所在的pivot的数据源,并刷新pivot
Setpvt=ActiveSheet.Range("
B6"
).PivotTable
pvt.ChangePivotCacheActiveWorkbook.PivotCaches.Create(SourceType:
=xlDatabase,SourceData:
=_
SheetName!
R4C2:
R"
lngLastRow&
C22"
Version:
=xlPivotTableVersion10)
pvt.PivotCache.Refresh
∙将一个图形(比如一个长方形的框"
Rectangle2"
)移动到与某个单元格对齐。
ws.Activate
Application.ScreenUpdating=True
ws.Shapes.Range(Array("
)).Select
)).Top=ws.Range("
T5"
).Top
)).Left=ws.Range("
).Left
∙遍历控件。
比如遍历所有的checkbox是否被打挑。
IfMe.OLEObjects("
CheckBox"
i).Object.Value=TrueThen
flgChecked=True
∙得到今天的日期
dateNow=WorksheetFunction.Text(Now(),"
YYYY/MM/DD"
∙在某个sheet页中查找某个关键字
****************************************************
Searchkeywordfromaworksheet(notworkbook!
PublicFunctionSearchKeyWord(wsAsWorksheet,keywordAsString)AsBoolean
Dimvar1AsVariant
Setvar1=ws.Cells.Find(What:
=keyword,After:
=ActiveCell,LookIn:
=xlFormulas,LookAt_
:
=xlPart,SearchOrder:
=xlByRows,SearchDirection:
=xlNext,MatchCase:
False,MatchByte:
=False,SearchFormat:
=False)
Ifvar1IsNothingThen
SearchKeyWord=False
SearchKeyWord=True
∙单元格为空,取不到值的时候,转化为空字符串。
Emptyto"
PublicFunctionChangeEmptyToString(varAsVariant)AsString
ChangeEmptyToString=CStr(var)
ChangeEmptyToString="
∙单元格为空,取不到值的时候,转化为0。
Emptyto0
PublicFunctionChangeEmptyToLong(varAsVariant)AsLong
ChangeEmptyToLong=CLng(var)
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Excel VBA常用代码总结1讲解学习 VBA 常用 代码 总结 讲解 学习