Excel VBA-自定义函数集

1，求得a年b月第c个星期d的日期‘/viewthread.php?tid=459346&pid=2991598&page=1&extra=page%3D1‘求得a年b月第c个星期d的日期Functionxqrq(myYear,myMonth,Optionaln%=1,Optionalmyxq%=1)AsDate

'myYear年份，myMonth月份，n第几个，myxq星期几

'myxq=1(周日)、2(周一)、3(周二)...

DimmyDateAsDate,xq%

myDate=DateSerial(myYear,myMonth,1)

xq=Weekday(myDate)

Ifmyxq<xqThen

xqrq=myDate+7-xq+myxq+7*(n-1)

Else

xqrq=myDate+7*(n-1)-xq+myxq

EndIf

EndFunction

用法：=xqrq(1991,3,2,4)

1991年3月第2个星期三

返回1991-3-13

n默认为第1个，myxq默认为星期日（＝1）

如果A1＝1991，B1＝3

E1＝xqrq(A1,B1,,)

返回1991-3-32，求得不相邻单元格区域的列数‘2010-2-5‘/viewthread.php?tid=535481&pid=3540112&page=1&extra=page%3D1Functionls(ParamArrayrngs()AsVariant)Dimd,ad1$,aa,bb,i%,j,cc1,cc2,ii%Setd=CreateObject("Scripting.Dictionary")Forii=0ToUBound(rngs)ad1=rngs(ii).Address(ReferenceStyle:=xlR1C1)IfInStr(ad1,",")>0Thenaa=Split(ad1,",")Fori=0ToUBound(aa)IfInStr(aa(i),":")>0Thenbb=Split(aa(i),":")cc1=Split(bb(0),"C")(1)cc2=Split(bb(1),"C")(1)Forj=Val(cc1)ToVal(cc2)d(j)=""NextElsej=Split(aa(i),"C")(1)d(j)=""EndIfNextElseIfInStr(ad1,":")>0Thenbb=Split(ad1,":")cc1=Split(bb(0),"C")(1)cc2=Split(bb(1),"C")(1)Forj=Val(cc1)ToVal(cc2)d(j)=""NextElsej=Split(ad1,"C")(1)d(j)=""EndIfEndIfNextls="有"&d.Count&"列。"EndFunction函数用法：＝ls(A2:A10,B4:d7,C5:G8)3，已知年月日的星期函数by:狼版主Functionmyweekday(ByValyAsLong,ByValmAsLong,ByValdAsLong)AsLongDimbiasAsLongIfm>2Thenbias=m-2Elsebias=10+my=y-1EndIfmyweekday=(d+(13*bias-1)\5+(yMod100)+(yMod100)\4+(y\100)\4-2*(y\100))Mod7+1EndFunction本文来自CSDN博客，转载请标明出处：/northwolves/archive/2010/01/09/5167118.aspx‘2010-9-18修改Functionmyweekday(ByValyAsLong,ByValmAsLong,ByValdAsLong)AsStringDimbiasAsLong,n&Ifm>2Thenbias=m-2Elsebias=10+my=y-1EndIfn=(d+(13*bias-1)\5+(yMod100)+(yMod100)\4+(y\100)\4-2*(y\100))Mod7+1myweekday="星期"&Mid("日一二三四五六",n,1)EndFunction4，工龄计算‘技巧600实例之543.xlsFunctionElapsed(StartDateAsDate,EndDateAsDate,ReturnTypeAsInteger)DimStartYearAsInteger'定义变量用以参数中开始日期的计算DimStartMonthAsIntegerDimStartDayAsIntegerDimEndYearAsInteger'定义变量用以参数中结束日期的计算DimEndMonthAsIntegerDimEndDayAsIntegerStartYear=Year(StartDate)'从参数中取得开始日期和结束日期的年数,月数,天数StartMonth=Month(StartDate)StartDay=Day(StartDate)EndYear=Year(EndDate)EndMonth=Month(EndDate)EndDay=Day(EndDate)IfEndDay<StartDayThen'若结束日期的天数小于开始日期参数的天数,执行下面语句EndDay=EndDay+(DateSerial(EndYear,EndMonth+1,EndDay)_-DateSerial(EndYear,EndMonth,EndDay))EndMonth=EndMonth-1'从月数中借1后再进行减运算,从而得到相差天数EndIfIfEndMonth<StartMonthThen'若结束日期参数中的月数小于开始日期参数的月数,则EndMonth=EndMonth+12EndYear=EndYear-1'从年数中借1后再进行减运算,从而得到相差月数EndIfSelectCaseReturnType'如果没有以上特殊情况,则直接进行相减的运算Case1'返回年数Elapsed=EndYear-StartYearCase2'返回月数Elapsed=EndMonth-StartMonthCase3'返回天数Elapsed=EndDay-StartDayEndSelectEndFunction5，排序‘/thread-747475-1-1.html2011-8-1FunctionSortString(strAsString,Optionalignorecase=False)DimarrAsVariant'Covertthestringtoanarray.arr=Split(str,"|")'Sortthearraycase-sensitiveorcase-insensitive.IfignorecaseThenSortArrayarr,vbTextCompareElseSortArrayarr,vbBinaryCompareEndIf'Convertthearraybacktoastringandreturnit.SortString=Join(arr,"|")EndFunctionSubSortArray(arrAsVariant,_OptionalcompareAsVbCompareMethod=vbBinaryCompare)DimlbAsInteger,ubAsInteger,iAsInteger,strAsStringDimjAsInteger'Ifargumentisnotanarray,thenexit.IfNotIsArray(arr)ThenExitSublb=LBound(arr)ub=UBound(arr)'Ifonlyoneelement,thenexit.Iflb=ubThenExitSubFori=lbToubstr=arr(i)Forj=lbToub'Swapvaluesifoutoforder.IfStrComp(str,arr(j),compare)=-1Thenstr=arr(j)arr(j)=arr(i)arr(i)=strEndIfNextNextEndSub6，不相邻单元格区域的重复个数和重复数据‘2013-6-6‘/thread-1024677-1-1.htmlFunctioncf(rngAsRange,rng1AsRange,Optionalrng2AsRange)Setd=CreateObject("scripting.dictionary")Setd1=CreateObject("scripting.dictionary")ForEachcelInrngd(cel.Value)=""NextForEachcelInrng1Ifd.Exists(cel.Value)Thend1(cel.Value)=""EndIfNextIfNotrng2IsNothingThenForEachcelInrng2Ifd.Exists(cel.Value)Thend1(cel.Value)=""EndIfNextEndIfcf=d1.CountEndFunctionFunctioncfsj(rngAsRange,rng1AsRange,Optionalrng2AsRange)Setd=CreateObject("scripting.dictionary")Setd1=CreateObject("scripting.dictionary")ForEachcelInrngd(cel.Value)=""NextForEachcelInrng1Ifd.Exists(cel.Value)Thend1(cel.Value)=""EndIfNextd.RemoveAllIfNotrng2IsNothingThenForEachcelInrng2Ifd1.Exists(cel.Value)Thend(cel.Value)=""EndIfNextIfd.Count>0Thencfsj=Join(d.keys,",")ElseIfd1.Count>0Thencfsj=Join(d1.keys,",")EndIfEndFunction7，金额阿拉伯数字分列‘2013-6-7‘/thread-1025062-1-1.htmlFunctionje(aa,n)Dimm&,i&m=19IfInStr(aa,".")Thenaa=Int(aa*100)Elseaa=aa*100EndIfFori=Len(aa)To1Step-1m=m-1Cells(n,m)=Val(Mid(aa,i,1))Nextm=m-1Cells(n,m)="￥"EndFunction8，内插‘2014-10-2‘/thread-1156010-1-1.htmlFunctionqq(x,y,zAsRange)r=zFori=3ToUBound(r)-1Ifx>=r(i,1)ThenExitForNextk1=(x-r(i-1,1))/(r(i,1)-r(i-1,1))Forj=3ToUBound(r,2)-1Ify<=r(1,j)ThenExitForNextk2=(y-r(1,j-1))/(r(1,j)-r(1,j-1))t1=r(i-1,j-1)+(r(i,j-1)-r(i-1,j-1))*k1t2=r(i-1,j)+(r(i,j)-r(i-1,j))*k1qq=t1+(t2-t1)*k2EndFunction9，所得税Functiontax(incomeAsSingle)AsSingleMin=3500SelectCaseincome-MinCaseIs<=0tax=0Case0To1500tax=(income-Min)*0.03Case1500To4500tax=(income-Min)*0.1-105