VBA自定义函数选合集(代码注释)

自定义函数选
附代码注释
By 蓝桥玄霜
前言
我们平时在工作表单元格的公式中常常使用函数，Excel自带的常用的函数多达300多个，功能强大，丰富多彩，博大精深。

在Excel内置函数和扩展函数中有十多个应用领域的函数，如数学与三角函数、统计函数、文本和数据函数、查找和引用函数、数据库函数、财务函数、日期和时间函数、信息函数、工程函数和宏表函数等等。

但是我们每个人还可能有各种各样的问题而不能直接应用这些函数得到解决，于是Excel也提供了VBA可以让我们自己编一个自定义函数来解决自己特定的需求。

以下挑选一些自定义函数，由简到繁，附以代码注释，供大家参考。

第1例折扣函数
一、题目：
要求编写一个当销售数量大于等于100时，售价打九折的计算折扣的自定义函数。

二、代码：
Function Zekou(sul, jiag) As Double
If sul>=100 Then
Zekou =sul*jiag*0.1
Else
Zekou =0
EndIf
Zekou =Application.Round(Zekou,2)
End Function
三、代码详解
1、Function Zekou(sul, jiag) As Double ：自定义函数的开始语句。

自定义函数总是以Function开头，以End Function语句结束。

自定义函数的代码一定要放在标准模块里面。

Zekou是函数名，名字可取一个较短的描述信名称，这样容易记忆。

如sul数量和jiag 价格，这里用的是拼音字母。

函数后括号里的两个变量叫做函数的参数。

两个参数都没有显式声明数据类型，都是可变型数据类型variant。

AS Double 表示函数返回值的数据类型是双精度浮点型数据。

2、If sul>=100 Then 如果sul（数量）大于等于100，那么
这是标准的If…Then…Else判断语句，意思是如果第一个条件成立，或者说满足了第一个条件，那么执行Then以后的语句；否则执行Else以后的语句。

3、Zekou =sul*jiag*0.1 折扣＝数量×价格×0.1
4、Else 否则执行下面的语句，
5、Zekou = 0 折扣＝0，即数量小于100时，不打折扣。

6、Zekou =Application.Round(Zekou,2) 这里用了工作表的Round函数，返回一个数值，该数值是按照指定的小数位数进行四舍五入运算的结果。

这里是按照2位小数进行四舍五入运算的折扣数值。

四、自定义函数用法
B2=450，C2＝100.00，D2＝Zekou(B2,C2) ‘返回4500.00
如图-1所示。

图-1 折扣函数用法
第2例两点之间距离的自定义函数
一、题目：
要求编写已知同一平面上两点的坐标值，求两点之间距离的自定义函数。

二、代码：
Function dist(x1, y1, x2, y2)
dist = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
End Function
三、代码详解
1、Function dist(x1, y1, x2, y2) ：自定义函数的开始语句。

自定义函数名称为dist，参数是两点的坐标值x1、y1、x2、y2。

2、dist = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2) ：
这是一个求两点间距离的公式，x坐标值差的平方与y坐标值差的平方之和的平方根就是两点之间的距离。

其中Sqr是VBA函数，返回一个Double（双精度数据），指定参数的平方根。

四、自定义函数用法
B2、B3单元格是点1的坐标值，D2、D3单元格是点2的坐标值，两点之间的距离为C5＝dist(B2,B3,D2,D3) ‘返回156792
如图-2所示。

图-2 dist函数的用法
第3例十进制角度转化为度分秒的自定义函数
一、题目：
要求编写把一个十进制的角度，转化为角的度分秒形式的自定义函数。

二、代码：
Function dfm(angle3) '度转化为度分秒
If angle3 < 0 Then
deg1 = -Int(Abs(angle3))
Else
deg1 = Int(angle3)
End If
min1 = (Abs(angle3) - Abs(deg1)) * 60
min2 = Int(min1)
sec1 = Int((min1 - min2) * 60)
dfm = deg1 & " °" & min2 & " '" & sec1 & " """
End Function
三、代码详解
1、Function dfm(angle3) ：自定义函数的开始语句。

自定义函数名称为dfm，度分秒的拼音首字母，参数是angle3。

2、If angle3 < 0 Then ：
如果角度小于0，那么执行下面的语句，否则执行else后面的语句。

3、deg1 = -Int(Abs(angle3)) ：
这句用了两个VBA函数，先是绝对值函数Abs，对负的角度取其绝对值，然后是取整函数Int，取角度的整数，加上-（负）以后赋值给变量deg1（整数度）。

这里为什么要先用
绝对值函数Abs呢？因为如果直接对负数取整，就会产生错误，如-36，直接对负数取整得到的是-37，而不是-36。

4、deg1 = Int(angle3) ：
如果角度是正的，只需要用取整函数Int，取角度的整数，赋值给变量deg1。

5、min1 = (Abs(angle3) - Abs(deg1)) * 60 ：
把角度的绝对值减去度绝对值的差乘以60，得到的值赋给变量min1（小数分）。

6、min2 = Int(min1) ：
把分取整的值赋给变量min2（整数分）。

7、sec1 = Int((min1 - min2) * 60) ：
把小数分减去整数分的差取整后乘以60，得到的值赋给变量sec1（整数秒）。

8、dfm = deg1 & " °" & min2 & " '" & sec1 & " """ ：
用字符连接运算符&把整数度整数分整数秒，中间加上度分秒的数学符号连接起来所形成的字符串赋给函数dfm。

四、自定义函数用法
A2、A3单元格的值是十进制的角度值，B2＝dfm(A2) ‘返回65°19’17”，B3＝dfm(A3) ‘返回-36°41’7”
如图-3所示。

图-3 dfm函数的用法
第4例个人所得税自定义函数
一、题目：
要求编写一个计算个人所得税的自定义函数。

二、代码：
Function grsds(ysr, Optional qzd=2000) As Single
Dim suil As Single, sukousu As Single, ynse As Single
ynse = ysr - qzd
Select Case ynse
Case 0 To 500
suil = 0.05: sukousu = 0
Case 501 To 2000
suil = 0.1: sukousu = 25
Case 2001 To 5000
suil = 0.15: sukousu = 125
Case 5001 To 20000
suil = 0.2: sukousu = 375
Case 20001 To 40000
suil = 0.25: sukousu = 1375
Case 40001 To 60000
suil = 0.3: sukousu = 3375
Case 60001 To 80000
suil = 0.35: sukousu = 6375
Case 60001 To 100000
suil = 0.4: sukousu = 10375
Case Else
suil = 0.45: sukousu = 15375
End Select
If ynse <= 0 Then
grsds = 0
Else
grsds = Round(ynse * suil - sukousu, 2)
End If
End Function
三、代码详解
1、Function grsds(ysr, Optional qzd=2000) As Single：自定义函数的开始语句。

以Function开始，grsds是函数名，名字可任意取名，这里用了个人所得税各字的拼音首字母，其它变量也是如此，如月收入ysr和起征点qzd。

函数后括号里的两个变量叫做函数的参数，在变量前加有Optional的表示是可选的参数，即可以用也可以不用它，这里＝2000表示该变量的默认值为2000，即如果不用它，变量qzd就＝2000。

AS Single 表示变量都声明为单精度浮点型变量。

Single（单精度浮点型）变量存储为32 位（4 个字节）浮点数值的形式，它的范围在负数的时候是从-3.402823E38 到-1.401298E-45，而在正数的时候是从1.401298E-45 到3.402823E38。

Single 的类型声明字符为感叹号(!)。

2、Dim suil As Single, sukousu As Single, ynse As Single：三个变量都声明为单精度浮点型变量。

其中suil代表（税率）、sukousu代表（速扣数）、ynse代表（应纳税额）。

3、ynse = ysr - qzd：把月收入（ysr)-起征点（qzd）的值赋给变量应纳税额（ynse）。

由于qzd变量可选而且有默认值2000，所以如果公式中省略该参数，该参数就等于2000。

4、Select Case ynse和End Select：是一组判断语句的一对开头和结束语句。

Ynse就是判断的条件。

Select Case与If…Then…Else判断语句很相似，但是前者允许在许多的条件值这种选择。

你可以有任意数量的Case行，并且在每行上可包含多个值，还可以使用To子句来包含一个值范围。

比如下面的Case 0 To 500语句。

5、Case 0 To 500：如果应纳税额（ynse）的值在0～500之间的话，就执行下面的语句。

如果应纳税额（ynse）的值不在0～500之间的话，就不执行下面的语句7而依次执行其它
的Case语句。

6、suil = 0.05: sukousu = 0 ：如税率＝0.05，速扣数＝0。

接着执行End Select语句退出判断语句。

直接执行If ynse <= 0 Then语句。

7、其它的Case语句相同。

最后一个Case Else语句表示如果上面所有的条件都不符合（也就是应纳税额大于100000时）那么税率= 0.45: 速扣数= 15375，退出判断语句。

8、If ynse <= 0 Then ：这是标准的If…Then…Else判断语句，如果应纳税额小于等于0的话，那么。

9、grsds = 0 ：那么个人所得税＝0。

否则
10、grsds = Round(ynse * suil - sukousu, 2) ：个人所得税＝应纳税额×税率-速扣数。

这里用了Round函数，返回一个数值，该数值是按照指定的小数位数进行四舍五入运算的结果。

这里是按照2位小数进行四舍五入运算的个人所得税数值。

四、自定义函数用法
A2=4500，B2＝grsds(A2) ‘返回250
A3=6000，B3＝grsds(A3,) ‘返回475
A4=8000，B4＝grsds(A3,2000) ‘返回825
如图-4所示。

图-4 个人所得税函数用法
第5例直角三角形未知边边长函数
一、题目：
要求编写一个已知直角三角形两条边的边长求另一条未知边边长的自定义函数。

二、代码：
Function bc (Optional short1, Optional short2, Optional longside)
If Not (IsMissing(short1)) And Not (IsMissing(short2)) Then
bc = Sqr(short1 ^ 2 + short2 ^ 2)
ElseIf Not (IsMissing(short1)) And Not (IsMissing(longside)) Then
bc = Sqr(longside ^ 2 - short1 ^ 2)
ElseIf Not (IsMissing(short2)) And Not (IsMissing(longside)) Then
bc = Sqr(longside ^ 2 - short2 ^ 2)
Else
bc = "需要有两条已知的边。

"
End If
End Function
三、代码详解
1、Function bc (Optional short1, Optional short2, Optional longside) ：自定义函数的开始语句。

自定义函数总是以Function开头，以End Function语句结束。

这里三个变量都是可选参数，实际上必须有两个参数。

代码中会判断引用的参数是短边1还是短边2，或者是长边，然后进行计算。

2、If Not (IsMissing(short1)) And Not (IsMissing(short2)) Then ：
这是标准的If…Then…Else判断语句，意思是如果有短边1并且有短边2，那么执行下面的语句，其中IsMissing是VBA函数，该函数返回一个Boolean（布尔）值，Boolean （布尔）值有两个：True（真）和False（假）。

指出一个可选的Variant（变体型）参数是否已经传递给过程，如果传递给过程了，则函数返回False（假），反之函数返回True（真）。

在(IsMissing(short1))前面加Not逻辑运算符，则返回一个逻辑非，即如果有参数1，IsMissing(short1)返回False（假），加了Not以后返回了True（真）。

我们平常说的“不假”，也就是“真”了。

3、bc = Sqr(short1 ^ 2 + short2 ^ 2) ：
计算公式是短边1的平方+短边2的平方的和再开平方。

这里用了Sqr函数，它也是一个VBA函数，返回指定参数的平方根。

4、ElseIf Not (IsMissing(short1)) And Not (IsMissing(longside)) Then ：
如果第一个条件不满足，但是有短边1并且有长边，那么执行下面的语句。

5、bc = Sqr(longside ^ 2 – short1 ^ 2) ：
计算公式是长边的平方-短边1的平方的差再开平方。

6、ElseIf Not (IsMissing(short2)) And Not (IsMissing(longside)) Then ：
如果第二个条件也不满足，但是有短边2并且有长边，那么执行下面的语句。

7、bc = Sqr(longside ^ 2 – short1 ^ 2) ：
计算公式是长边的平方-短边2的平方的差再开平方。

8、Else ：
如果以上条件都不满足，那么执行下面的语句。

9、bc = "需要有两条已知的边。

" ：
把一个字符串返回给函数bc。

四、自定义函数用法
A1、A2是边长，A1=26.36，A2＝30.24，B3＝bc(A1,A2,) ‘返回40.12 注意：这里省略了第3个参数长边；
B4＝bc(A1,,A2) ‘返回14.82 注意：这里用了第3个参数长边，省略了第2个参数短边2。

B5＝bc(,A1,A2) ‘返回14.82注意：这里用了第3个参数长边，省略了第1个参数短边1。

B6＝bc(A1,,) ‘返回"需要有两条已知的边。

" 注意：省略了2个参数。

如图-5所示。

图-5 bc函数用法
第6例两直线交点坐标的自定义函数
一、题目：
要求编写已知两条直线的直线方程，求两条直线交点的坐标的自定义函数。

二、代码：
Function jiaox1(coea1, coeb1, coec1, coea2, coeb2, coec2)
jiaox1 = -(coec1 * coeb2 - coec2 * coeb1) / (coea1 * coeb2 - coea2 * coeb1) End Function
Function jiaoy1(coea1, coeb1, coec1, coea2, coeb2, coec2)
jiaoy1 = -(coea1 * coec2 - coea2 * coec1) / (coea1 * coeb2 - coea2 * coeb1) End Function
三、代码详解
1、Function jiaox1(coea1, coeb1, coec1, coea2, coeb2, coec2) ：自定义函数的开始语句。

自定义函数名称为jiaox1，参数分别是直线方程的系数值coea1、coeb1、coec1、coea
2、coeb2、coec2。

2、jiaox1 = -(coec1 * coeb2 - coec2 * coeb1) / (coea1 * coeb2 - coea2 * coeb1) ：
交点的X坐标jiaox1，右边为交点的X坐标的计算公式。

交点的Y坐标jiaoy1的计算公式类似。

四、自定义函数用法
直线的标准方程为：Ax+By+C=0
直线1的方程为：y=2x+1 coea1=2; coeb1=-1; coec1=1
直线2的方程为：y=-x+4 coea2=-1; coeb2=-1; coec2=4
A2、D2、G2单元格是直线1方程的系数，A4、D4、G4单元格是直线2方程的系数，两直线交点的X1坐标为C7＝jiaox1(A2,D2,G2,A4,D4,G4) ‘返回1
两直线交点的Y1坐标为C7＝jiaoy1(A2,D2,G2,A4,D4,G4) ‘返回3
如图-6所示。

图-6 jiaoy1函数的用法
第7例两直线夹角的自定义函数
一、题目：
要求编写一个已知两条直线上的四个点的坐标，求两直线的夹角的自定义函数。

二、代码：
Function jiaj(x1, y1, x2, y2, x3, y3, x4, y4) '两直线的夹角
'2009-5-20修改
'直线1逆时针转向直线2之夹角
If (x1 = x2 And y1 = y2) Or (x3 = x4 And y3 = y4) Then jiaj = "不是两条直线！": Exit Function
If x1 = x2 Then '直线1平行Y轴
If x3 = x4 Then '直线2平行Y轴
jiaj = "两条直线平行不相交！": Exit Function
Else
kkk2 = (y3 - y4) / (x3 - x4)
jiaj = Application.Degrees(Atn(kkk2))
If jiaj < 0 Then
jiaj = 90 + jiaj
Else
jiaj = 90 - jiaj
End If
End If
ElseIf x3 = x4 Then
kkk1 = (y1 - y2) / (x1 - x2)
jiaj = Application.Degrees(Atn(kkk1))
jiaj = 90 - jiaj
Else
kkk1 = (y1 - y2) / (x1 - x2): kkk2 = (y3 - y4) / (x3 - x4)
If (1 + kkk1 * kkk2) <> 0 Then
jiaj = (kkk2 - kkk1) / (1 + kkk1 * kkk2)
jiaj = Application.Degrees(Atn(jiaj))
If jiaj < 0 Then
jiaj = 180 + jiaj
Else
jiaj = 180 - jiaj
End If
End If
End If
jiaj = dfm(jiaj)
End Function
三、代码详解
1、Function jiaj(x1, y1, x2, y2, x3, y3, x4, y4) ：自定义函数的开始语句。

自定义函数名称为jiaj，八个参数分别是4个点的坐标值。

2、If (x1 = x2 And y1 = y2) Or (x3 = x4 And y3 = y4) Then jiaj = "不是两条直线！": Exit Function：如果每一条直线的x、y坐标值两两相等，那么这是两个点，不是直线了；所以jiaj返回“不是两条直线！”，并退出。

3、If x1 = x2 Then ：下面对直线1的x坐标值进行一些判断，如果x1=x2，则直线1垂直x轴；那么执行下面的代码；
4、If x3 = x4 Then ：再对直线2的x坐标值进行判断，如果x3=x4，则直线2也垂直x轴；如果直线2垂直x轴，那么执行下面的代码；
5、jiaj = "两条直线平行不相交！": Exit Function ：返回信息并退出函数。

6、kkk2 = (y3 - y4) / (x3 - x4) ：如果直线2不垂直x轴，那么求得直线2的斜率kkk2；
7、jiaj = Application.Degrees(Atn(kkk2)) ：
这里运用了两个函数，一个是VBA函数Atn，反正切函数；另一个是Excel的函数Degrees，将弧度转为十进制的度。

Excel的函数在VBA中不能直接引用，必须在函数前面加Application对象；而VBA函数Atn可以直接运用。

Atn(kkk2)返回夹角的弧度值，再用Degrees函数将弧度转为十进制的度。

这时的变量jiaj的值还不是两直线十进制的夹角，而是直线2与x轴的十进制夹角；
8、If jiaj < 0 Then ：如果夹角小于0那么执行下面的代码；这里实际是判断直线2的斜率是否小于0，
9、jiaj = 90 + jiaj ：如果夹角小于0那么两直线十进制的夹角就等于90+jiaj；
10、jiaj = 90 - jiaj ：否则两直线十进制的夹角就等于90-jiaj；
11、下面的判断与上面的类似，不再多说了；
12、kkk1 = (y1 - y2) / (x1 - x2): kkk2 = (y3 - y4) / (x3 - x4) ：
变量kkk1和kkk2分别是两条直线的斜率，计算公式等于y1-y2的值除以x1-x2的值。

kkk2前面的“:”表示后面是另一个语句，相当于另起一行。

13、If (1 + kkk1 * kkk2) <> 0 Then ：
如果1+kkk1*kkk2的值不等于0，那么执行下面的语句；
14、jiaj = (kkk2 - kkk1) / (1 + kkk1 * kkk2) ：
这里变量jiaj的值等于上述的公式计算的值，还不是两直线的夹角；
15、If jiaj < 0 Then jiaj = 180 + jiaj ：
如果jiaj小于0，那么jiaj就等于180+jiaj。

两条直线的夹角的大小在0～180°之间，自定义函数jiaj是以x1，y1，x2，y2两点组成的直线1逆时针转到以x3，y3，x4，y4两点组成的直线2所形成的夹角。

16、jiaj = dfm(jiaj) ：
这里引用了另一个自定义函数dfm，目的是把十进制的度转换成度分秒的形式显示出来。

自定义函数dfm见第3例。

只要自定义函数dfm在同一个工作簿中，就可以象VBA函数一样直接引用。

四、自定义函数用法
参数说明：x1,y1 直线1上点1的x，y坐标值；x2,y2是直线1上点2的x,y坐标值；
x3,y3 直线2上点3的x，y坐标值；x4,y4是直线2上点4的x,y坐标值
使用示例：
点1(35260,192410) 点2(83210,341690)
点3(-6405722,-3115123) 点4(-6413459,-3131370)
B2、B3、D2、D3、F2、F3、H2、H3单元格的值分别是各坐标值。

B7＝jiaj(B2,B3,D2,D3,F2,F3,H2,H3)，返回夹角为172°20’35”
如图-7所示。

图-7 jiaj函数的用法
第8例可见单元格求和函数
一、题目：
要求编写一个只对可见单元格求和的自定义函数。

二、代码：
Function kjdygSUM(rng As Variant)
Dim cel As Range
For Each cel In rng
If cel.EntireRow.Hidden = False Then
kjdygSUM = kjdygSUM + cel.Value
End If
Next cel
End Function
三、代码详解
1、Function kjdygSUM(rng As Variant) ：自定义函数的开始语句。

自定义函数名称为kjdygSum，不受大小写的影响。

变量rng声明为变体型数据类型Variant。

Variant数据类型是所有没被显式声明（用如Dim、Private、Public 或Static等语句）为其他类型变量的数据类型。

Variant是一种特殊的数据类型，除了定长String 数据及用户定义类型外，可以包含任何种类的数据。

2、Dim cel As Range ：
声明变量cel为单元格区域。

3、For Each cel In rng ：
这是又一种循环语句，For Each是For …Next的一个变异，而且是VBA独有的，它适合于处理数组和对象集合。

意思是在区域rng中的每一个单元格cel，一个个循环执行下面的语句。

4、If cel.EntireRow.Hidden = False Then ：
如果单元格所在的行是可见的话，那么执行下面的语句。

5、kjdygSUM = kjdygSUM + cel.Value ：
可见单元格的和就等于可见单元格数值的累加。

四、自定义函数用法
A1～A12中每个单元格的值都＝10，其中第3、5、7、10行隐藏了。

B13＝kjdygsum(A1:A12) ‘返回80
如图-8所示。

图-8 kjdygsum函数的用法
第9例单元格区域不重复值的自定义函数
一、题目：
要求编写已知单元格区域，求区域中不重复值的自定义函数。

二、代码：
Function Bcfz(rng As Range)
Dim d As Object, rCell As Range
Set d = CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each rCell In rng
If Not d.exists(rCell.Text) Then
If rCell <> "" Then
d.Add rCell.Text, 1
End If
End If
Next rCell
Bcfz = d.keys
Set d = Nothing
End Function
三、代码详解
1，Function Bcfz(rng As Range) ：自定义函数的开始语句。

自定义函数名称为Bcfz，是“不重复值”的拼音首字母，便于记忆；参数是单元格区域rng。

2、Dim d As Object, rCell As Range ：
声明变量d为一般对象，rCell为区域对象。

Object也是一种数据类型，涉及的范围很广，这里不再深入探讨，只要了解一下即可。

3、Set d = CreateObject("Scripting.Dictionary") ：
这里使用Set语句把字典对象赋值给对象变量d，CreateObject函数，创建并返回一个对ActiveX 对象的引用。

（注：Dictionary对象是VBScript语言（Visual Basic程序设计语言的最新家族成员）中的一个对象。

如果不用CreateObject函数，要在应用程序中使用Dictionary对象，就必须利用Reference（引用）对话框增加一个项目级的引用到Scripting Runtime Library（脚本运行时库）。

）
4、On Error Resume Next ：
On Error Resume Next语句是VBA中的错误处理程序语句，这里的意思是如果语句执行中发生了错误，就执行下一条语句，以免代码显示出错信息而中断。

5、For Each rCell In rng ：
For Each…Next循环语句，对区域对象rng中的每个单元格rCell对象作循环。

6、If Not d.exists(rCell.Text) Then ：
如果字典d里面不存在单元格rCell的内容，那么执行下面的语句。

7、If rCell <> "" Then ：
为了使空值不进入字典d中，所以再增加一个判断语句：如果单元格rCell不等于空，那么执行下面的语句。

8、d.Add rCell.Text, 1 ：
就把单元格rCell的内容作为关键字增加到字典中。

9、Bcfz = d.keys ：
把字典的关键字赋值给函数Bcfz返回，这里d.keys是一个数组。

10、Set d = Nothing ：
把变量d设置为Nothing，即取消字典对象与变量d的关联。

四、自定义函数用法
Sub yy1()
Dim rng As Range ‘声明变量rng为区域对象
Set rng = [a1:c10] ‘把A1到C10单元格区域赋值给变量rng
[d1].Resize(UBound(Bcfz(rng)) + 1, 1) = Application.Transpose(Bcfz(rng))
End Sub
最后一句代码比较复杂，引用了带参数rng的自定义函数Bcfz，Resize是单元格对象的属性，调整指定区域的大小。

返回Range对象，该对象代表调整后的区域。

Ubound 函数返回一个 Long 型数据，其值为指定的数组维可用的最大下标，这里的Bcfz函数返回的是以0为下标开始值的数组，如本例的数组下标从0～4，总数是5个，但是Ubound函数返回的最大下标是4，所以在Resize调整区域中要+1，表示有五行，另一个参数1表示一列，从前面[d1]单元格开始调整为五行一列，即[d1:d5]，把不重复值经过转置后赋给它们。

Transpose函数是Excel工作表函数，在VBA中使用时前面要加上Application对象。

Transpose函数可以把行转换成列。

把自定义函数和过程yy1的代码输入在模块1里面，如图-9a所示；然后在工作表上使用窗体工具栏的按钮控件做一个按钮，把宏yy1指定给此按钮，把按钮名改为“不重复值”。

现在只要点按此按钮，就能在D1~D5单元格得到A1~C10单元格区域的不重复值了。

如图-9b所示
图-9a 两段代码
图-9b 不重复值自定义函数的用法
第10例活动单元格加指定单元格内容批注的自定义函数
一、题目：
要求编写一个可分别把指定单元格的内容作为批注写入活动单元格的自定义函数。

如果活动单元格里面没有批注就增加此批注；如果里面有批注就把批注修改为指定单元格的内容。

二、代码：
Function pizhu(ParamArray Rngs() As Variant)
Dim cel As Range, s$, singleArea,m%
For m = LBound(Rngs) To UBound(Rngs)
Set singleArea = Rngs(m)
For Each cel In singleArea
If cel <> "" Then
s = s & cel.Value & vbCrLf
End If
Next cel
Next m
With ActiveCell
If .Comment Is Nothing Then
.AddComment Text:=s
Else
.Comment.Text Text:=s
End If
End With
pizhu = ""
End Function
三、代码详解
1，Function pizhu(ParamArray Rngs() As Variant) ：自定义函数的开始语句。

自定义函数名称为pizhu，是“批注”的拼音字母，便于记忆；参数是单元格区域,一个数组变量Rngs()。

使用关键字ParmArray说明的参数可在调用时接受传递给它的任何个数的参数。

这些参数被放在一个可变类型数组中。

如果未使用Option Base语句，数组的下界为0。

要注意的是ParmArray 只能用于参数表的最后一个参数。

2、Dim cel As Range, s$, singleArea,m% ：声明变量cel为单元格区域对象，s为字符
串数据类型，m为整型，为可变型数据类型。

3、For m = LBound(Rngs) To UBound(Rngs) ：
这是标准的For …Next循环语句，LBound和UBound是两个VBA函数，可求得数组的下界和上界，下界默认为0。

4、Set singleArea = Rngs(m) ：
把单元格区域逐个赋值给变量singleArea。

5、For Each cel In singleArea ：
For Each…Next循环语句，对区域对象singleArea中的每个单元格cel对象作循环。

6、If cel <> "" Then ：如果cel单元格不为空，那么执行下面的语句。

7、s = s & cel.Value & vbCrLf ：把cel单元格的值加上换行符一起赋给变量s。

第一次循环时，s为空值，以后随着循环而把区域内所有单元格的值一起赋给变量s。

8、With ActiveCell ：使用With…..End With语句有三个优点：它可以减少代码的输入量；增加代码的可读性和改善代码的执行效率。

它为我们提供了十分简便的对象引用手段。

9、If .Comment Is Nothing Then ：如果活动单元格没有批注，那么执行下面的语句。

10、.AddComment Text:=s ：使用区域对象的增加批注属性AddComment，批注文本等于变量s的值。

11、.Comment.Text Text:=s ：否则使用区域对象的批注属性Comment，把原来的批注修改为新的文本等于变量s的值。

12、pizhu = "" ：函数返回一个空值。

四、自定义函数用法
例如A1、B2和C3单元格里面不为空，活动单元格为D5。

在D5里输入公式：=pizhu(A1,B2,C3) 或者输入：＝pizhu(A1:F6)
如图-10所示。

图-10 批注自定义函数的用法
第11例求字符串中符合范围数的和的自定义函数
一、题目：
单元格中有汉字，英文，标点符号，数字，但是不含时间和日期，要求编写一个字符串中满足条件>＝10，<＝10^13数字的和的自定义函数。

二、代码：
Function getl(R1 As Range) As Double
Dim x%, temp$, Arr(), aa$, y%, temp1$
If R1.Count > 1 Then MsgBox "本代码仅适用于一个单元格！": Exit Function
For x = 1 To Len(R1) - 1
temp = Mid(R1, x, 1)
If temp Like "[0-9,.]" Or (Asc(temp) <= -23623 And Asc(temp) >= -23632) Then aa = aa & temp
Else
aa = "": GoTo 100
End If
For y = x + 1 To Len(R1)
temp1 = Mid(R1, y, 1)
If (temp1 Like "[0-9,.]" And aa <> "") Or (Asc(temp1) <= -23623 And Asc(temp1) >= -23632 And aa <> "") Then
aa = aa & temp1
If y = Len(R1) Then
r = r + 1
ReDim Preserve Arr(1 To r)
Arr(r) = CDbl(aa)
aa = "": x = y
End If
Else
r = r + 1
ReDim Preserve Arr(1 To r)
Arr(r) = CDbl(aa)
aa = ""
x = y: Exit For
End If
Next y
100:
Next x
For x = 1 To r
If Arr(x) >= 10 And Arr(x) <= 10 ^ 13 Then
getl = getl + Arr(x)
End If
Next x
End Function
三、代码详解
1，Function getl(R1 As Range) As Double ：
自定义函数的开始语句。

自定义函数名称为getl，参数R1声明为区域对象，函数返回值声明为双精度浮点数据类型。

2、Dim x%, temp$, Arr(), aa$, y%, temp1$ ：
声明变量x为整型数据，temp、temp1和aa为字符串变量，Arr()为可变类型数组。

3、If R1.Count > 1 Then MsgBox "本代码仅适用于一个单元格！“: Exit Function ：
如果单元格区域中单元格数目大于1，则信息框显示”本代码仅适用于一个单元格！“，然后退出结束函数。

4、For x = 1 To Len(R1) - 1 ：
循环语句x从1 到单元格字符串长度－1结束。

5、temp = Mid(R1, x, 1) ：
依次将从单元格字符串中取出一个字符，赋值给变量temp。

6、If temp Like "[0-9,.]" Or (Asc(temp) <= -23623 And Asc(temp) >= -23632) Then ：
如果变量temp 是0-9数字，是小数点”.”或者这个字符的ASC码小于等于-23623并且大于等于-23632，那么执行下面的语句。

这个判断语句是为了提取小数点和数字，运用了比较运算符Like，它的作用是比较两个字符串的内容，当字符串的内容包含在样板字符串中时，比较结果为True。

”[0-9,.]”是样板字符串，注意要有双引号，数字必须按照升序显示，中间用”-“连接。

由于单元格里有双字节数字存在，它们的ASC码范围在-23623和-23632之间，所以用了前后两个判断，只要满足一个就执行下面的语句。

7、aa = aa & temp ：
把变量temp和变量aa连接形成新的字符串赋值给变量aa。

如果数字是连续的，就可获得一个完整的数字了。

8、aa = "": GoTo 100 ：
如果变量temp不是数字，则把空字符串赋给变量aa，接着执行第100句，判断单元格中下一个字符。

9、For y = x+ 1 To Len(R1) ：
嵌套循环语句y从x+1 到单元格字符串长度结束，前一个字符是数字以后接着判断下一个字符是不是数字。

后面3句与上述的5、6、7句一样，只是变量是temp1。

10、If y = Len(R1) Then ：
如果变量y是单元格的最后一个数字，那么执行下面的语句。

11、r = r + 1 ：
变量r+1以后赋给变量r，相当于计数器一样。

12、ReDim Preserve Arr(1 To r) ：
重新声明动态数组Arr，大小从1到r，用了关键字Preserve 可确保原来包含数据的数组中的任何数据都不会丢失。

13、Arr(r) = CDbl(aa) ：
把变量aa用CDbl函数转换成双精度浮点型数据以后赋给数组变量Arr。

14、aa = "": x = y ：
把把空字符串赋给变量aa，把y的值赋给变量x，进入第一个循环。

后面4句与上述的11～14句一样，只是退出第二个循环。

15、For x = 1 To r ：
取出所有的数字以后，再一个循环语句x从1 到r结束。

用来判断这些数字是否符合条件并且计算那些符合条件的数字的和。

16、If Arr(x) >= 10 And Arr(x) <= 10 ^ 13 Then ：
判断这些数字是否符合条件，如果数组变量Arr(x)大于等于10并且小于等于10的13次方的话，那么执行下面的求和语句。

17、getl = getl + Arr(x) ：
把数组变量Arr(x) 累加后赋给函数getl，完成整个函数过程。

四、自定义函数用法
例如A列单元格里面为包含数字的字符串，活动单元格为C2。

在C2里输入公式：=getl(A2) 如图-11所示。

图-11 getl自定义函数的用法。