自定义函数总结Word格式文档下载.docx
《自定义函数总结Word格式文档下载.docx》由会员分享，可在线阅读，更多相关《自定义函数总结Word格式文档下载.docx（31页珍藏版）》请在冰豆网上搜索。
IfNotIsMissing（var2）Then
Setr=rng.Find（str2,,,2）
IfrIsNothingThenFindMsg=FindMsg&
IIf（FindMsg="
str2&
Elsevar2=r.Column
EndIf
IfNotIsMissing（var3）Then
Setr=rng.Find（str3,,,2）
str3&
Elsevar3=r.Column
IfNotIsMissing（var4）Then
Setr=rng.Find（str4,,,2）
str4&
Elsevar4=r.Column
IfNotIsMissing（var5）Then
Setr=rng.Find（str5,,,2）
str5&
Elsevar5=r.Column
IfNotIsMissing（var6）Then
Setr=rng.Find（str6,,,2）
str6&
Elsevar6=r.Column
IfNotIsMissing（var7）Then
Setr=rng.Find（str7,,,2）
str7&
Elsevar7=r.Column
IfNotIsMissing（var8）Then
Setr=rng.Find（str8,,,2）
str8&
Elsevar8=r.Column
IfNotIsMissing（var9）Then
Setr=rng.Find（str9,,,2）
str9&
Elsevar9=r.Column
IfNotIsMissing（var10）Then
Setr=rng.Find（str10,,,2）
str10&
Elsevar10=r.Column
IfFindMsg<
>
ThenFindMsg="
Can'
tfind"
FindMsg
SubTest（）
Dims1&
s2&
s3$,v1%,v2%,v3%,MSG$
FindColumnMSG,[a1:
iv1],v1,"
IssueNo"
v2,"
SystemID"
v3,"
I-EndCustomer"
Debug.Printv1,v2,v3,MSG
结果：
107Can'
tfind'
SystemID'
3.填充
SubFillSeries（RngAsRange,colAsInteger）
‘向右填充到第几列
Rng.AutoFillRng.Resize（Rng.Rows.Count,col-Rng.Column+1）
应用：
Subt（）
FillSeries[a150:
a156],3
4.排序
冒泡法升序排序
FunctionBubbleSortAsc（Ary）
‘可排序数字和字符串；
升序
DimaryUBound,i,j,temp
aryUBound=UBound（Ary）
Fori=0ToaryUBound
Forj=i+1ToaryUBound
IfAry（i）>
Ary（j）Then
temp=Ary（i）
Ary（i）=Ary（j）
Ary（j）=temp
Next
BubbleSortAsc=Ary
EndFunction
DimdicAsObject,k,i,j
dic.Add"
abc"
1
aac"
6
adc"
7
k=BubbleSortAsc（dic.items）
Fori=LBound（k）ToUBound（k）
Debug.Printk（i）
Next
5.月份英文转换成数字
FunctionMonthName2Number（monthNameAsString）AsInteger
trytoconvertmonthnametoactualdatetype
DimdtestrAsString
dtestr=monthName&
/1/2000"
DimdteAsDate
OnErrorResumeNext
dte=CDate（dtestr）
IfErr.Number<
0Then
MonthName2Number=0
ExitFunction
EndIf
OnErrorGoTo0
MonthName2Number=Month（dte）
Debug.PrintMonthName2Number（"
March"
）,MonthName2Number（"
Mar"
结果
33
补充：
从数字转换成月份名字：
Worksheetfunction.Text（2,"
mmm"
）“ddd”表星期“mmmm”表月份全称
6.按月份排序字典
SubSortMonthDic（objAsObject）
Dimi&
j&
arr1,arr2,ke
arr1=obj.keys
arr2=obj.items
Fori=LBound（arr1）ToUBound（arr1）
Forj=i+1ToUBound（arr1）
IfCDate（arr1（i）&
）>
CDate（arr1（j）&
）Then
temp=arr1（i）:
arr1（i）=arr1（j）:
arr1（j）=temp
temp=arr2（i）:
arr2（i）=arr2（j）:
arr2（j）=temp
obj.RemoveAll
obj.Addarr1（i）,arr2（i）
应用在包含月份英文名字的字典
如
Subkk（）
DimdicAsObject
May"
五月好"
Apr"
四月桥"
October"
八月（ˇ?
ˇ）想～"
SortMonthDicdic
ForEachkeIndic.keys
Debug.Printke,dic（ke）
Nextke
7.浏览文件路径
可将xlsx改为想要浏览的文件类型，返回路径
FunctionBrowseFile（OptionalpromptAsString）AsString
Browse.xlsxfile&
getpath
DimFileTypeAsString
FileType="
Allfiles（*.*）,*.*,"
Excelfiles（*.xlsx）,*.xlsx"
BrowseFile=Application.GetOpenFilename（FileType,1,prompt）
IfBrowseFile="
False"
ThenBrowseFile="
相对路径
FunctionBrowseFileRelativePath（OptionalpromptAsString）AsString
func:
获取单个文件相对本Workbook路径
DimFileFilterAsInteger
FileType="
Excelfiles（*.xls）,*.xls"
BrowseFilePath=Application.GetOpenFilename（FileType,2,prompt）
IfBrowseFilePath="
Then
BrowseFilePath="
Else
BrowseFilePath=Replace（BrowseFilePath,ThisWorkbook.Path,"
8.浏览文件夹路径
对话框形式
FunctionBrowseFolder（OptionalpromptAsString="
请选择文件"
OptionalinitialAsString）
Application.FileDialog（msoFileDialogFolderPicker）.InitialFileName="
WithApplication.FileDialog（msoFileDialogFolderPicker）
.ButtonName="
确定"
.Title=prompt
.InitialFileName=initial
If.Show=TrueThenBrowseFolder=.SelectedItems
（1）
EndWith
9.浏览文件夹路径（Shell方式）
FunctionBrowseFolder（OptionalCaptionAsString="
请选择文件夹"
_
OptionalInitialFolderAsVariant）AsString
DimflAsObject,shlAsObject
Setshl=CreateObject（"
Shell.Application"
Setfl=shl.BrowseForFolder（0,Caption,0,InitialFolder）
IfNotflIsNothingThen
BrowseFolder=fl.self.Path
BrowseFolder="
EndIf
Dimk
k=BrowseFolder
Debug.Printk
10.从全路径中提取
提取路径
FunctiongetPath（fullNameAsString）AsString
获得文件路径，通过把文件名置空
DimvarVarAsVariant
varVar=Split（fullName,"
\"
varVar（UBound（varVar））="
getPath=Join（varVar,"
提取文件名
存在性判断
11.Worksheet是否存在
FunctionshtExists（wbAsWorkbook,ShAsString）AsBoolean
DimshtAsWorksheet
OnErrorResumeNext
Setsht=wb.Worksheets（Sh）
IfErr.Number=0Then
shtExists=True
Else
shtExists=False
Setsht=Nothing
12.Path是否存在（简单）
可检查路径下的文件或文件夹是否存在，文件夹格式要求不严
FunctionPathExists（pname）AsBoolean
Format:
file-"
C:
\Folder\yy.txt"
folder-"
\Folder\"
or-"
\Folder"
DimxAsString
x=GetAttr（pname）And0
IfErr=0ThenPathExists=True_
ElsePathExists=False
Debug.PrintPathExists（"
\Users\yluo35\Documents\Excel\查办.xlsx"
）‘文件
Debug.PrintPathExists（"
\Users\yluo35\Documents\Excel\"
）‘文件夹
\Users\yluo35\Documents\Excel"
13.Path是否存在（较为复杂）
可检查路径下的文件或文件夹是否存在，文件夹格式要求
FunctionPathExists（FNameAsString）AsBoolean
DimxAsString
IfFName<
x=Dir（FName）
Ifx<
ThenPathExists=TrueElsePathExists=False
PathExists=False
Debug.PrintFolderExists（"
14.Folder是否存在
FSO方法，只能检查文件夹是否存在
FunctionFolderExists（FDNameAsString）AsBoolean
DimfsoAsObject
Setfso=CreateObject（"
Scripting.FileSystemObject"
IfFDName="
Orfso.FolderExists（FDName）=FalseThen
FolderExists=False
FolderExists=True
15.列号转换成列名
FunctionCoLr（ColNumberAsInteger）AsString
OnErrorGoToErrorhandler
CoLr=Split（Cells（1,ColNumber）.Address,"
$"
）
（1）
Errorhandler:
MsgBox"
Errorencountered,pleasere-enter"
vbExclamation
CoLr
（2）->
“B”
16.列名转换成数字
FunctionCoNo（ColLetterAsString）AsString
CoNo=Columns（ColLetter）.Column
17.获得查找单元格地址
FunctionFindRng（SearchRngAsRange,FindValue,OptionalResultAsInteger=1）
DimrngAsRange
Setrng=SearchRng.Find（FindValue,,,1）
IfrngIsNothingThen
FindRng=0
SelectCaseResult
Case1'
Returnrow
FindRng=rng.Row
Case2'
Returncolumn
FindRng=rng.Column
Case3'
Returnaddress
FindRng=rng.Address（0,0）
Case4'
ReturncolumnLetter
FindRng=Split（rng.Address,"
EndSelect
18.交换两个变量的值
FunctionSwap（a,b）
Dimtmp
tmp=a
a=b
b=tmp
Dima%,b%
a=10:
b=20
Swapa,b
Debug.Printa,b
19.Workbook是否已打开
方法一
FunctionWbOpen（WbPath）AsBoolean
DimwbAsWorkbook
DimwbNameAsString
wbName=Split（WbPath,"
\
升级会员 