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自定义函数的用法
excel利用vba定义函数的教程全解
excel利用vba定义函数的教程全解 用vba定义函数步骤1：例：下面表格中需要计算一些三角形的 面积 用vba定义函数步骤2：B列是底边长，C列是高，要求在D列 通过公式计算三角形面积。 (通常我们会在D3单元格用公式=B3*C3/2来计算，然后把这个 公式向D列下方拖动复制，得到其他公式。这只是一个简单的例子，通过它来学习编写简单的自定义函数) 用vba定义函数步骤3：打开VBA窗口 按ALT+F11调出VBA窗口，插入一个用户模块。 用vba定义函数步骤4：编写代码 把下面这个自定义函数代码粘贴到刚插入的用户模块中就可以使用了。 Functionsjxmj(di,gao) sjxmj=di*gao/2 EndFunction 这段代码非常简单只有三行，先看第一行，其中sjxmj是自己取的函数名字，括号中的是参数，也就是变量，di表示“底边长”，gao表示“高”，两个参数用逗号隔开。 再看第二行，这是计算过程，将di*gao/2这个公式赋值给sjxmj，即自定义函数的名字。 用vba定义函数步骤5：使用自定义函数 用vba定义函数步骤6：通过上面例子可以了解自定义函数的编 写和使用方法，下面再介绍一个稍微复杂点的自定义函数。
经常对数据进行处理的朋友可以会遇到多条件查找某一个数据，一般这种情况需要编写“数组公式”来解决，公式较长，也不易理解。 比如下面统计成绩的表格，需要根据A1:D7的成绩表，统计出两门功能都在90分以上的学生人数。 大家可以看到在H3单元格中的公式比较长，理解起来也有一定难度。 我们通过自定义函数也可以得到正确结果，函数代码如下： Function统计(a,b,c,d,e) Fori=1Toa.Rows.Count Ifb=a.Cells(i,1)Anda.Cells(i,c)>=eAnda.Cells(i,d)>=eThen 统计=统计+1 EndIf Next EndFunction 这个函数用了五个参数(因为涉及到一个区域和四个条件) 参数a表示要统计的区域，在此例中为B2:E7 参数b表示要统计的是哪一个班级，在此例中为G3单元格 参数d表示数学成绩相对于区域第一列向右的列数，在此例中为4 参数e表示分数，在此例中为90分 提示：要注意参数c和d“相对”于“区域”的列数，并非是从A列开始向右的列数。 把上面这段代码也粘贴到用户模块中就可以使用了
EXCEL VBA 新个人所得税税率自定义函数IN_TAX()及用法
Excel VBA新个人所得税税率自定义函数in_tax()及用法1、VBA代码 Public Function in_tax(in_month As Single)As Single Dim sl As Single,kcs As Single,ynse As Single'定义税率sl,扣除数kcs,应纳税额ynse变量 ynse=in_month-3500 Select Case ynse Case0To1500'如果应纳税额<=1500,税率3%,速算扣除数0。 sl=0.03 kcs=0 Case1501To4500'如果应纳税额(1500,4500],税率10%,速算扣除数105。 sl=0.1 kcs=105 Case4501To9000'如果应纳税额(4500,9000],税率20%,速算扣除数555。 sl=0.2 kcs=555 Case9001To35000'如果应纳税额(9000,35000],税率25%,速算扣除数1005。 sl=0.25
kcs=1005 Case35001To55000'如果应纳税额(35000,55000],税率30%,速算扣除数2755。 sl=0.3 kcs=2755 Case55001To80000'如果应纳税额(55000,80000],税率35%,速算扣除数5505。 sl=0.35 kcs=5505 Case Else'如果应纳税额>80000,税率45%,速算扣除数13505。 sl=0.45 kcs=13505 End Select If ynse<=0Then in_tax=0 Else in_tax=Round(ynse*sl-kcs,2) End If End Function 2、使用方法
VBA常用代码大全
.、八、- 刖言 我们平时在工作表单元格的公式中常常使用函数，EGcel自带的常用的函数多达300多个, 功能强大，丰富多彩，但是在 VBA中不能直接应用，必须在函数名前面加上对象，比如：Applicatio n. WorksheetF un ctio n.Sum(arg1,arg2,arg3) 。 而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数, 以供大家学习参考。 第1.1例ASC函数 一、题目： 要求编写一段代码，运行后得到字符串”EGcel”的首字母和” e”的ASCII值。 二、代码： Sub 示例_1_01() DimmyNum1%,myNum2% myNum仁Asc("EGcel")'返回 69 myNum2=Asc("e")' 返回 101 [a1]="myNum 1=":[b1]=myNum1 [a2]="myNum2=":[b2]=myNum2 En dSub 三、代码详解 1、Sub示例_1_01():宏程序的开始语句。 2、DimmyNum1%,myNum2% :变量 myNum1 和 myNum2 声明为整型变量。 也可以写为DimmyNum1AsInteger 。Integer变量存储为16位(2个字节)的数值形式，
其范围为-32,768到32,767之间。Integer的类型声明字符是百分比符号(％)。 3、myNum1=Asc("EGcel"):把 Asc 函数的值赋给变量 myNum1 。 Asc函数返回一个Integer，代表字符串中首字母的字符的 ASCII代码。 语法 Asc(stri ng) 必要的string (字符串)参数可以是任何有效的字符串表达式。如果string中没有包含任何字符，则会产生运行时错误。 4、myNum2=Asc("e"):把Asc函数的值赋给变量myNum2。这里返回小写字母e的ASCII 代码101。 5、 [a1]="myNum仁":[b1]=myNum1 :把字符串“ myNum仁“赋给A1单元格，把变量myNum1的值赋给B1单元格。 6、 [a2]="myNum2=":[b2]=myNum2 :把字符串“ myNum2= “赋给 A2 单元格，把变量myNum2的值赋给B2单元格。 7、 EndSub :程序的结束语句，和“ Sub示例_1_01 ()”相对应。 第1.2例Chr函数 一、题目"": 要求编写一段代码，运用 Chr函数将ASCII值转换为对应的字符 二、代码： Sub 示例_1_02() DimmyChar1$,myChar2$ myChar仁Chr(69)'返回 E。 myChar2=Chr(101)' 返回 e。 [a1]="myChar1=":[b1]=myChar1 [a2]="myChar2=":[b2]=myChar2
史上最全面的计算简体繁体汉字笔画的VBA自定义函数及汉字笔画字库
Function char_wordnum(my_char_word) '史上最权威最全面的计算简体繁体汉字笔画的VBA自定义函数及汉字笔画字库 'from bdQuaker 20140619 '笔画数据库来自在线新华字典 https://www.360docs.net/doc/4b2793850.html, 'VBA中一条语句内的换行符号，不能超过25个。 '函数功能：对输入的汉字，返回其笔画的数量。 Dim char_wordtable(31), wordnum_i, wordnum_j, wordnum_k, temp_wordnum temp_wordnum = "" If my_char_word = "" Then char_wordnum = 0 Exit Function End If char_wordtable(0) = "" char_wordtable(1) = "" char_wordtable(2) = " " char_wordtable(3) = " 亏马亇么门宀万卄女丬丌乞千犭刃刄三山彡上勺饣士尸扌氵巳纟" + _ "夊土乇丸亾兦亡尢囗卫?兀习夕下乡小忄彐卂劜丫幺也弋亿已义于亐与丈夂之子" char_wordtable(4) = "卬夭仈巴办勽贝币比卞仌不仓长尺车丑丒仇刅从亣歹丹邓弔订仃斗队仒厄乏反方分凤 " + _ " " + _ "闩双水亖太天邒厅圡屯屲瓦卐卍罓尣王韦厃为文毋勿午五乌兮心匂凶牙圠爻辷忆刈艺以弌冘引尹尤友肀予元円月曰匀云勻允帀扎兂仄仉爫爪止支中专卆" char_wordtable(5) = "艾屵凹叐叭扒白半包北本夯必弁边丙氷仢癶布卟仺册冊仧仩仦斥叱叺刍処出处丛匆刌打代歺旦石氹辺忉叨氐电叼汈鸟饤忊艼奵帄叮东冬乧叾对戹弍尓尔尒发犯氾払" + _ "冯弗付玍尕轧匃匄仠甘冮夰乬巪仡功句古冎叧瓜叏丱広宄氿归扖邗汉厈号禾仜弘讧乎囘卉屶屷汇伋记饥刉击叽甲加戋匞叫艽讦节钅丼冋匛旧纠凥且卡冚刊尻厼可叩" + _ "凷圦邝兰艻叻扐氻忇乐立厉屴礼辽另令龙卢圥劢邙矛夘卯们汅灭民皿末仫目母奶艿疒尼囜宁奴汃皮庀丕氕平叵圤扑讫邔刋阡仟巧邛卭芁叴犰扏囚玌丘去厺犮冉让讱" + _ "仞仭辸扔宂邚仨壭讪闪邖叶申圣生辻仕世丗示市史矢失朮术帅甩氺四丝司玊亗他它夳冭台叹讨夲朰田芀圢庁汀仝头凸阤仛讬外罒未戊阢务卌邜仚仙屳写阠兄玄穴廵" + _ "讯训疋圧央业凧匇匜仪肊议阣衤印囙用永由甴幼右邘驭玉込夗戉曱孕匝仔庂汄札乍占仗召厇氶正卮汁只主左" char_wordtable(6) = "吖阨伌安犴仰朳玐百阪邦闭毕朼夶邠冰并伧艸奼汊扱扠犲芆忏产辿伥场仯伡尘臣丞成朾弛池驰伬吃充冲虫岀汌舛传闯创朿次此汆伜存忖邨达汏刐伔凼圵当乭导氘朷" + _
[实用参考]VBA常用代码大全.doc
前言 我们平时在工作表单元格的公式中常常使用函数，EGcel自带的常用的函数多达300多个，功能强大，丰富多彩，但是在VBA中不能直接应用，必须在函数名前面加上对象，比如：Application.WorksheetFunction.Sum(arg1,arg2,arg3)。 而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数，以供大家学习参考。 第1.1例ASC函数 一、题目： 要求编写一段代码，运行后得到字符串”EGcel”的首字母和”e”的ASCII值。二、代码： Sub示例_1_01() DimmyNum1%,myNum2% myNum1=Asc("EGcel")'返回69 myNum2=Asc("e")'返回101 [a1]="myNum1=":[b1]=myNum1 [a2]="myNum2=":[b2]=myNum2 EndSub 三、代码详解 1、Sub示例_1_01()：宏程序的开始语句。 2、DimmyNum1%,myNum2%：变量myNum1和myNum2声明为整型变量。 也可以写为DimmyNum1AsInteger。Integer变量存储为16位（2个字节）的数值形式，其范围为-32,768到32,767之间。Integer的类型声明字符是百分比符号(%)。 3、myNum1=Asc("EGcel")：把Asc函数的值赋给变量myNum1。
Asc函数返回一个Integer，代表字符串中首字母的字符的ASCII代码。 语法 Asc(string) 必要的string（字符串）参数可以是任何有效的字符串表达式。如果string中没有包含任何字符，则会产生运行时错误。 4、myNum2=Asc("e")：把Asc函数的值赋给变量myNum2。这里返回小写字母e的ASCII代码101。 5、[a1]="myNum1=":[b1]=myNum1：把字符串“myNum1=“赋给A1单元格，把变量myNum1的值赋给B1单元格。 6、[a2]="myNum2=":[b2]=myNum2：把字符串“myNum2=“赋给A2单元格，把变量myNum2的值赋给B2单元格。 7、EndSub：程序的结束语句，和“Sub示例_1_01（）”相对应。 第1.2例Chr函数 一、题目""： 要求编写一段代码，运用Chr函数将ASCII值转换为对应的字符。 二、代码： Sub示例_1_02() DimmyChar1$,myChar2$ myChar1=Chr(69)'返回E。 myChar2=Chr(101)'返回e。 [a1]="myChar1=":[b1]=myChar1 [a2]="myChar2=":[b2]=myChar2 EndSub 三、代码详解
Excel VBA常用代码VSTO版20150425
21-1 使用工作表的名称 this.Application.Worksheets["工作表2"].Activate(); 21-2 使用工作的索引号 this.Application.Worksheets[2].Activate(); 21-3 使用工作表的代码名称 MessageBox.Show(this.Application.ActiveSheet.CodeName); 21-4 用ActiveSheet属性引用活动工作表 this.Application.Worksheets[2].Select(); MessageBox.Show(https://www.360docs.net/doc/4b2793850.html,); 22-1 选择工作表的方法 this.Application.Worksheets[2].Select(); this.Application.Worksheets[2].Activate(); 23-1 使用For遍历工作表 intwkCount = this.Application.Worksheets.Count; string s = string.Empty; for (inti = 1; i<= wkCount; i++) { s = s + this.Application.Worksheets[i].Name + "\n"; } MessageBox.Show("工作簿中含有以下工作表:" + "\n" + s); 23-2 使用ForEach语句 string s = string.Empty; foreach (Excel.Worksheetwk in this.Application.Worksheets) { s = s + https://www.360docs.net/doc/4b2793850.html, + "\n"; } MessageBox.Show("工作簿中含有以下工作表:" + "\n" + s); 24-1 在工作表中向下翻页 Excel.Sheetsshs=Globals.ThisWorkbook.Worksheets; Excel.WorksheetwkThis = shs.Application.ActiveSheet; Excel.WorksheetwkNext; intwkIndex = wkThis.Index; intwkCount = shs.Count; if (wkIndex 利用VBA自定义函数解决 业务研究加入时间：2007-3-9 20:42:35 点击：504 Microsoft Office套装办公软件是大家十分熟悉的办公软件，在工作中经常使用。但在水文工作中，仍然感觉到有很不方便的时候！比如，水文行业广泛使用的“四舍六入五单双”，就很难用Microsoft Office中的内部函数进行处理。但是与Microsoft Office套装办公软件绑定的VBA(Visual Basic For Application)语言提供了强大的二次开发功能，笔者以Excel为例，用它来解决上面所提到的问题，就非常容易了。 一、水文及水质资料使用的“四舍六入五单双”，执行《数值修约规范》（GB8170-87）１.拟舍弃数字的最左一位数字小于５时，则舍去，即保留的各位数字不变。 ２.拟舍弃数字的最左一位数字大于５时；或者是５，而其后跟有并非全部为０的数字时，则进一，即保留的末位数字加１。 ３. 拟舍弃数字的最左一位数字为５，而后面无数字或皆为０时，若所保留的末位数字为奇数(1,3,5,7,9)则进一，为偶数(２,4,6,8)则舍弃。 二、初识VBAIDE 打开Excel，按Alt+F11即进入VBAIDE，在菜单上依次点击[插入]->[模块]，然后输入如下代码： ' “四舍六入五单双”自定义函数 ' 函数形式 Round5(x,mm)，返回值Round5为 Double 型 ' X为操作数值，mm为保留小数位数 ' mm为 Integer 型，mm = 0 表示取整数 Private Function round5(X As Double, mm As Integer) As Double Dim Temp1, Temp2 As String Temp1 = 1 If mm < 0 Then Temp1 = 10 ^ Abs(mm) X = X / Temp1 mm = 0 End If If ((Int((Abs(X) - Int(Abs(X))) * 10 ^ mm) Mod 2) = 0 And (Abs(X) * 10 ^ mm - Int(Abs(X) * 10 ^ mm)) <= 0.5) And X <> Val(Round(Abs(X), mm) * Sgn(X)) Then round5 = Val((Round(Abs(X) - 10 ^ (-mm) / 5, mm))) Else round5 = Val(Round(Abs(X), mm)) End If round5 = Val( round5 * Sgn(X) * Temp1) End Function 以上程序是在“取绝对值（Abs）”、“取整（Int）”、“四舍五入（Round）”等系统内部函数的基础上完成的，函数的型式及其每个参数需要用户在属性设置中定义和声明，故叫做自定义函数。以上定义“四舍六入五单双”的函数名为Round5，定义成功后便可在Excel 中象系统函数那样引用了，例如对编辑完后按Alt+Q即返回Excel，再在某一单元格输入“= Round5(A1,３)”(A1既可以是单元格,也可以是输入的数值),回车结果就出来了。如果出现 目录 '1.函数作用：返回 Column 英文字 (9) '2.函数作用：查询某一值第num 次出现的值................9 '3.函数作用：返回当个人工资薪金所得为2000元(起征点为850元时的应纳个人所得税税额.............................10 '4.函数作用：从形如"123545ABCDE"的字符串中取出数字....11 '5.函数作用：从形如"ABCD12455EDF"的字符串中取出数字...11 '6.函数作用：按SplitType 取得RangeName 串值中的起始位置12 '7.函数作用:将金额数字转成中文大写....................13 '8.函数作用:计算某种税金..............................18 '9.函数作用:人民币大、小写转换........................19 '10.函数作用:查汉字区位码.............................20 '11.函数作用:把公元年转为农历.........................21 '12.函数作用:返回指定列数的列标.......................42 '13.函数作用:用指定字符替换某字符.....................43 '14.函数作用:从右边开始查找指定字符在字符串中的位置...43 '15.函数作用:从右边开始查找指定字符在字符串中的位置...44 '16.函数作用:计算工龄.................................44 '17.函数作用:计算日期差，除去星期六、星期日.. (45) '18.函数作用:将英文字反转的自定函数 (46) '19.函数作用:计算个人所得税...........................46 '20.函数作用:一个能计算是否有重复单元的函数...........47 '21.数字金额转中文大写................................48 '22.函数 作用:将数字转成英文...........................49 '23.函数作用:人民币大小写转换.........................52 '24.函数作用:获取区域颜色值...........................53 '25.函数作用:获取活动工作表名.........................53 '26.函数作用:获取最后一行行数. (54) '27.函数作用:判断是否连接在线.........................54 '28.函数作用:币种转换.................................54 '29.函数作用:检验工作表是否有可打印内容...............55 '30. 函数作用:查找一字符串(withinstr在另一字符串中(findstr1中某一次(startnum出现 时的位置，返回零表示没找到。..................................................57 '31.函数作用:增加文件路径最后的“\”符号..............58 '32.函数作用:计算所得税...............................58 '33.函数作用:从工作表第一行的标题文字以数字形式返回所在列号..................................................58 '34.函数作用:在多个工作表中查找一个范围内符合某个指定条件的项目对应指定范围加总求和..........................59 '35.函数作用:返回 Excel VBA 编程 调用函数 调用函数时，为了使用函数的返回值，必须指定函数给变量，并且用括号将参数封闭起来。 语法：函数过程名（[参数列表]） 由于函数过程名返回一个值，故函数过程不能作为的单独语句加以调用，必须作为表达式或表达式的一部分，然后再配以其他的语法成分构成语句。 在调用函数之前，应首先来定义一个函数，如定义一个myreplace(S,Olds,NewS)函数过程，即用News 子字符串替换在S 字符串中出现的OldS 字符串。 例如，下面的程序是对前面自定义的函数过程CalculateSquareRoot 的调用，其代码如下： Private Sub CommandButton1_Click() Dim a a = InputBox("请输入数字") '调用CalculateSquareRoot 函数 MsgBox "计算平方根:" & CalculateSquareRoot(CInt(a)) End Sub 返回工作表中，单击【计算平方根】按钮，在弹出的如图9-3所示的对话框中，输入数字 25。然后，单击【确定】按钮，即可弹出如图9-4所示的效果。 图9-3 输入数字 图9-4 显示结果 注 意 “参数列表”称为实参或实元，它必须与形参保持个数相同，位置与类型一一对应。其中，实参可以是同类型的常数、变量、数组元素或表达式。 另外，在Visual Basic 中，通过WorksheetFunction 对象可使用Excel 工作表函数。例如，以下Sub 过程使用Min 工作表函数来确定单元格区域中的最小值，其代码如下： Sub UseFunction() Dim myRange As Range Set myRange = Worksheets("Sheet1").Range("A1:C10") answer = Application.WorksheetFunction.Min(myRange) MsgBox answer End Sub 从上述的代码可以观察到，用户将变量myRange 声明为Range 对象，然后将其设置为Sheet1上的A1至C10单元格区域。指定另一个变量answer 为对myRange 应用Min 函数的结果。最后，answer 的值显示在消息框中，效果如图9-5所示。 输入 单击 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！ 使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量 ...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String * length（定长字符串）、Object、Variant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是 Private。 Const My = 456 ' 声明 Public 常数。 Public Const MyString = "HELP" ' 声明 Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就 可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim(ActiveCell.Value) end sub 单元格位移 sub my_offset ActiveCell.Offset(0, 1).Select'当前单元格向左移动一格 ActiveCell.Offset(0, -1).Select'当前单元格向右移动一格 ActiveCell.Offset(1 , 0).Select'当前单元格向下移动一格 ActiveCell.Offset(-1 , 0).Select'当前单元格向上移动一格 end sub 如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往 sub my_offset 之下加一段代码 on error resume next 注意以下代码都不再添加sub “代码名称” 和end sub请自己添加! 给当前单元格赋值 ActiveCell.Value = "你好！！！" 给指定单元格赋值 例如：Ａ１单元格内容设为"ＨＥＬＬＯ" Range("a1").value="hello" 又如：你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ" 1. sheets("sheet2").select 用VBA编写Excel自定义的累加函数 郑云勇 云南楚雄思远投资有限公司 摘要：Excel是常用的数据统计分析软件，本文介绍了用VBA编写加载宏的方法来扩展、定制Excel，以适合工程统计专业的特殊需要。下面，讨论如何实现一个自定义的具有任意合计形如“30.2m/165.45m3”的“分子/分母”工程量统计功能的函数，由于Sum函数系统已经内置，我们要实现的函数不妨命名为uLSum和uRSum。 关键词：Excel，定制，加载宏 1引言 电子表格软件Microsoft Excel具有快捷方便的数据输入方式和强大的数据处理能力，是工程地质中常用的数据统计分析软件，为我们的工作带来了极大的方便。但Excel毕竟只是一个通用的办公软件，对于工程专业中的各种特殊需求，它自然不会有专门的功能支持。比如：采矿工程师在做每年的采掘生产计划时，通常遇到要累加掘进工程量的合计数，即“30.5/125.6”加“120.2/625.8”的合计，我们通常的做法是分步完成，先将分子之、分母之和求出来后，在填入单元格中。或者将分子、分母分别填入两列中，分别用sum函数求和。这样既劳神，又容易出错，特别是对大量数据进行复杂的公式计算。如果从头编写一个独立、专门的计算程序来处理，则似有小题大作之嫌，而且还不能与Excel无缝集成。那么有 没有更好的解决办法呢？答案是肯定的，那就是定制Excel，通过编程扩展它的功能。 事实上，Excel作为Microsoft最优秀的软件之一，很早就开始提供了二次开发的接口，4.0版以前有XLM，4.0版又发布了Excel C API，5.0版则内置了VBA。现在的Excel，除了人所共知的操作功能外，还是一个完善的软件开发平台。它拥有完备的ActiveX Automation服务器和客户机机制，可以通过编程对其进行全方位的扩展、定制，实现各种自定义功能。基于ActiveX Automation技术，使用C/C++等多种支持Automation的编程语言均可控制Excel，但我们最为熟悉和常用的还是内置于Excel中的VBA。 2VBA简介 Visual Basic for Application(VBA)是Microsoft面向最终用户的应用软件编程语言。它最早出现于Microsoft的Excel和Project中，如今VBA已成为VB和所有Office产品的组件。另外，越来越多的软件开发商购买了VBA语言的使用权，如常用的绘图软件AutoCAD等均已支持VBA作为二次开发工具。这意味着我们懂得VB，就已经懂得了VBA，反之亦然。 VBA的最大特点和最大优点是利用面向对象(OOP)的ActiveX Automation技术，使语言的引擎在技术上与开发环境分离，这可以从在任何VBA的IDE环境中都可以看到VBA单独的入口得到印证。因此，VBA的功能在很大程度上依赖于它的客户显露的Automation 接口，例如，VB与Office套件中的VBA，能完成的功能就大不一样。 '################## stdevR=average(max-min)/R系数组内差 Function stdevR(ParamArray rng() As Variant) As Variant Dim rang As Range, rngi As Range, T As Single, F As Single, i As Integer, e As Integer Dim trr Dim arr() Dim brr() For Each r In rng If rang Is Nothing Then Set rang = r Else Set rang = Union(rang, r) For Each c In r Next Next n = rang.Cells.Count aa = rang.Columns.Count bb = rang.Rows.Count cc = Application.WorksheetFunction.Ceiling(n / 5, 1) If aa > 1 Then ReDim arr(1 To bb) For i = 1 To bb Set rngi = rang(i, 1).Resize(1, aa) arr(i) = Application.Max(rngi.Value) - Application.Min(rngi) Next F = Application.WorksheetFunction.Average(arr) trr = [{0,1.128,1.693,2.059,2.326,2.534,2.704,2.847,2.97,3.078,3.173,3.258,3.336,3.407,3.472,3.532,3.58 8,3.64,3.689,3.735,3.778,3.819,3.858}] T = trr(aa) stdevR = F / T Else e = 0 ReDim brr(1 To cc) For i = 1 To cc Set rngi = rang(1, 1).Resize(5, 1).Offset(e, 0) brr(i) = Application.Max(rngi.Value) - Application.Min(rngi) e = e + 5 Next F = Application.WorksheetFunction.Average(brr) T = 2.326 stdevR = F / T End If End Function '################## ppk=min(ppu,ppl)=(1-k)*pp 整体的过程能力指数带中心值的 Function ppk(USL As Variant, LSL As Variant, ParamArray rng() As Variant) As Variant Dim AV As Single, rang As Range, n As Integer, T As Single, SumN As Single, SE As Single, k As Single For Each r In rng If rang Is Nothing Then Set rang = r Else Set rang = Union(rang, r) For Each c In r Excel VBA编程的常用代码 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！ 使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量 ...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal （当前不支持）、Date、String（只限变长字符串）、String * length（定长字符串）、Object、Variant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是Private。 Const My = 456 ' 声明Public 常数。 Public Const MyString = "HELP" ' 声明Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim(ActiveCell.Value) 自定义函数选 附代码注释 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以后的语句。 Excel VBA 常用代码50例 001。用命令按扭打印一个sheet1中B2:M30区域中的内容? 我想在Sheet2中制件一个命令按扭, 打印表Sheet1中的[B2:M30] 区域中的内容? 解答：可以将打印区域设为b2：m30，然后打印，如：sheets("sheet1").printarea="b2:m30" sheets("sheet1").printout 随手写的，你可以试试看。最简单的方法是：你先录制宏，在录制宏过程中，跑到页面设臵里面，把打印范围设臵到你想要的范围。 然后退出，停止录制宏，你就可以得到一些代码！ 002。能否对一列中的文字统一去掉最后一个字?这些文字不统一,有些字数多,有些字数少。如何处理?我用{"&-}不行 解答：=REPLACE(A1,LEN(A1),1," ")(在过渡列进行) 003.能否根据单元格数值自动标记序号？ 各位大佬，一工作表有两列，“序号”及“金额”，能否将金额不等于0的行自动标上序号呢？如无现成的函数，应怎样设臵？ 解答：Dim xuhao As Integer xuhao = 1 Range("b2").Select Do While Selection <> "" If Selection <> 0 Then ActiveCell.Previous.Value = xuhao xuhao = xuhao + 1 End If ActiveCell.Offset(1, 0).Range("a1").Select Loop 004.求教自定义函数 查询了一些自定义函数的例子都是单变量的。自定义函数能否建立“(As Range) As Interger”的函数，应该可以的，请各位大师赐教！请以“∑x2”为例，万分感谢！(该用"For Each ...Next"，就是还不知道如何引用Range中的每个值，请高手指点。) 解答：参数使用Range而函数值为Integer是可以的 用for each next循环思路也是对的，应该这样作： dim rg as range dim ivalue as integer for each rg in 参数区域 ivalue=ivalue+rg.value next 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是 Private。 Const My = 456 ' 声明 Public 常数。 Public Const MyString = "HELP" ' 声明 Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。Sub My_Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim end sub 单元格位移 sub my_offset (0, 1).Select'当前单元格向左移动一格 (0, -1).Select'当前单元格向右移动一格 (1 , 0).Select'当前单元格向下移动一格 (-1 , 0).Select'当前单元格向上移动一格 end sub 如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往 sub my_offset 之下加一段代码 on error resume next 注意以下代码都不再添加sub “代码名称” 和end sub请自己添加! 给当前单元格赋值 = "你好！！！" 给指定单元格赋值 例如：Ａ１单元格内容设为"ＨＥＬＬＯ" Range("a1").value="hello" 又如：你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ" 1. sheets("sheet2").select range("a1").value="hello" 或 2. Sheets("sheet1").Range("a1").Value = "hello" 说明： 被选中，然后在将“HELLO"赋到A1单元格中。 不必被选中，即可“HELLO"赋到sheet2 的A1单元格中。“四舍六入五单双”利用VBA自定义函数解决
excel中161个VBA_自定义函数(超级实用)(精)
Excel VBA编程 调用函数
Excel VBA编程的常用代码
用VBA编写Excel自定义的累加函数
原创—EXCEL VBA SPC自定义函数包括CPK PPK CP……
Excel VBA编程的常用代码
VBA自定义函数选合集(代码注释)
Excel VBA 常用代码50例
excelvba编程的常用代码