用VBA编写Excel自定义的累加函数

用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，能完成的功能就大不一样。

当然，如其他许多通用编程语言一样，VBA可以方便地直接调用许多传统DLL（VB不能生成）模块中的函数，只要这些函数使用的数据类型能被VBA处理。另一方面，由于VBA是基于ActiveX Automation 技术，它可以使用任何支持Automation技术的组件中的类和对象，换句话说，它能够集成系统中的各种支持Automation技术的应用程序共同工作。

VBA语言简单易学，但功能却不寻常，其运行效率对于普通的应用也完全能满足需要。一般而言，使用VBA可以做到：①定制和扩展客户应用程序功能；②将客户应用程序及数据集成到其他应用程序中。

在Excel中，VBA最常见的用途即是录制宏。每个可以用键盘或菜单命令完成的动作均能被宏记录下来，然后对不同数据进行（或播放）同一批操作。录制宏可以保存在当前工作簿中，也可以保存在个人工作簿中。当宏保存在个人工作簿中时，当前用户每次打开Excel时便都能使用其中包含的宏。

记录宏把需要用户重复的工作自动化，这其实已经是对Excel 的定制。但它仅仅是定制或扩展Excel的开端。因为，系统自动记录的宏虽然常常罗列了一大堆代码，但真正有用的却很少，且没有嵌入错误处理方案，至于我们需要实现的系统中没有的特殊功能，自然不可能有记录。另外，录制宏也没有能与整个Excel系统完全融合，不便于提供给其他用户使用。利用VBA定制Excel，Microsoft 推荐采用加载宏－即全局宏的方式。

3函数实现

在Excel电子表格中最常使用的函数应该是Sum了，它是内置的；当然，在Excel中内置的函数还有很多；但是，往往我们使用的函数Excel中并没有直接提供，或者提供了我们并不知道，这个时候可以自己使用VBA定义一个自己需要使用的函数参与电子表格单元格的计算，这在日常工作中可能是经常要遇到的一个问题。下面，讨论如何实现一个自定义的具有自动合计分子分母式样功能的函数。

首先，想到的应该使用VBA，毫无疑问，最直接的针对Excel 功能的扩展来源于VBA。事实上，我们可以在Excel的Microsoft Visual Basic编辑器的模块中增加一个公共函数来实现该自定义函数，该公共自定义函数是可以在Excel单元格中直接像使用Excel 内置函数一样使用的。

使用菜单“工具——宏——Visual Basic编辑器”或者直接使用快捷键【Alt+F11】组合键，打开Microsoft Visual Basic编辑器窗口；

在“工程”浏览器窗口中的树状目录的任一项目上单击右键，使用“插入——模块”命令；OK，在这个模块编辑器中，即可以开始编辑自定义函数了。

在此之前，我们应该考虑该函数的参数形式，和内置的Sum函数进行类比，我们可以发现Sum函数的参数应该是一个或多个单元格，而在VBA中对应的就应该是一个Range对象（关于Range对象

可以参考Microsoft Visual Basic帮助中的Excel VBA对象模型），也就是说我们要自定义的函数的参数应该是一个Range对象，由此，我们可以在“模块1”的编辑器中自定义几个如下的函数：用ulSUM、urSUM求m/m3的值

3.1编写函数分别取得分子和分母的数值

'取得如“200/800”字符串右边的数字“800”(函数1)

Public Function fipR(str1As String)As Double

Dim m As Integer

Dim ss As String

m=查询分隔位置(str1)

If Len(str1)=0Then

ss=0

Else

ss=Mid(str1,m+1)

End If

fipR=CDbl(ss)

End Function

'查询分子式中“/”字符的位置(函数2)

Public Function查询分隔位置(ByVal sstrcha As String)As Integer

If sstrcha=""Or IsNull(sstrcha)=True Then Exit Function

查询分隔位置=InStr(1,sstrcha,"/",1)

End Function

'取得如“200/800”字符串左边的数字“200”(函数3) Public Function fipL(str1As String)As Double Dim m As Integer

Dim ss As String

m=查询分隔位置(str1)

If Len(str1)=0Then

ss=0

Else

ss=Left(str1,m-1)

End If

fipL=CDbl(ss)

End Function

'累加分子(函数4)

Public Function uLSum(ParamArray x())As Double Dim i As Integer

Dim j As Integer

Dim k As Integer

Dim rtn As Double

rtn=0

For i=0To UBound(x)

For j=1To x(i).Rows.Count

For k=1To x(i).Columns.Count

rtn=rtn+fipL(x(i).Cells(j,k)) Next k

Next j

Next i

uLSum=rtn

End Function

'累加分母(函数5)

Public Function uRSum(ParamArray x())As Double Dim i As Integer

Dim j As Integer

Dim k As Integer

Dim rtn As Double

rtn=0

For i=0To UBound(x)

For j=1To x(i).Rows.Count

For k=1To x(i).Columns.Count

rtn=rtn+fipR(x(i).Cells(j,k)) Next k

Next j

Next i

uRSum=rtn

End Function

函数很简单，遍历Range对象的所有单元格，使其中的数字相加后返回即可。

在上面的描述中，我们使用到VBA的ParamArray特性，使得uLSum、uRSum函数既能接受连续单元格区域中的数据求和，也能接收不连续单元格区域中的数据求和，如uLSum(B2:C3,B5:C6)，函数4和函数5均能接受不定数量的多个参数。

保存更改后，返回到工作簿Book1界面，在连续的单元格（如B2:C3）中录入几个数字，然后在另外一个单元格（如E4）中录入“= uLSum(B2:C3)&"/"&uRSum(B2:C3)”，也就是说，我们使用我们自定义的合计函数uLSum、uRSum来计算区域B2:C3中的工程量数字之和。经过验证，我们可以发现这两个函数可以实现内置函数Sum 的合计功能。

至此，我们可以这样使用类似于=Sum(B2:C3,B5:C6,B8:C9)的公式了。也就是说，我们已经实现了一个和内置Sum函数一样功能的自定义函数了。

3.2实例

当然，在VBA函数编写好并存盘后，今后打开文件，必须选择【启用宏】按钮，才能在工作簿中使用自定义的函数。如下图所示。

¨

霉Ｃ日ｇ虬悍ｅ０００／２监００ｅｅ≮霉哥日Ｊｉ０００、ａａ日００

日０００、Ｓｉｅ００

Ｓｉ３日０、Ｊｉｊａ０Ｊ

８ｅｊ０、ｉ日日００

ｉａ０Ｊ０／３３日８０Ｊ

３３６８／Ｊｂ０日ｂＪＪ

Ｊ８３ｂＪ＼８ｉａａｏｉｄＪ￥☆

，Ⅻ￥甘

￥甘ｋ喜

ｉｋ｝！斟目亩怀：《＃并ｎｉ遵％■目ｊ００８士ｅ甘

望县弓埕ｂ曾ｂ喜￥

Ｅｅｓ?

｝＝ｎＴ２Ⅲ（Ｅｅ３：Ｅｅ＾）Ｆ。＼。Ｆ“２Ⅲ（Ｅｅ３：Ｅｅ＾）

＝工Ｔ…州删一…?Ｂ、Ⅱ；ｉ■司毫＊?ｗ≈一

：］醴１’１１７蚵寻？１留?＾

??矛∑?７ｆ甜霄第五届矿山技术论文发布会实例应用，如下图所示：在E62单元格中，有公式“=uLSum (E63:E67)&"/"&uRSum(E63:E67)”，如此即可分别求出分子分母的合计值了。4结语

当然，本篇文章的目的不仅是如何实现一个合计函数，而是讨论关于自定义函数的实现过程，举一反三之后，可以解决很多平时可能遇到的问题，便于节省时间、提高工作效率。

第五届矿山技术论文发布会

参考文献：

[1]赵志东，2006年，Excel VBA基础入门，人民邮电出版社；

[2]伍云辉等，2008年，Excel VBA办公应用开发详解，电子工业出版社；

[3]张峋，2007年，Excel VBA入门与典型实例，清华大学出版社；

[4]伍云辉，2007年，ExcelVBA应用高效开发案例精华版，电子工业出版社；

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(ESteel)自定义函数源代码

Public Function DJ(钢筋直径As Single, 最小搭接直径As Single, 搭接类别As String, 机械接头As String, 锚固As Single) Dim x As Integer, X1 As Integer, X2 As Integer, a As Integer If 钢筋直径> 0 Then a = 1 Else a = 0 End If If 钢筋直径> 最小搭接直径Then If 机械接头= "双面焊10D" Then DJ = 钢筋直径+ 2 End If If 机械接头= "单面焊5D" Then DJ = 钢筋直径/ 2 + 2 End If If 机械接头= "直螺纹" Then DJ = 0 End If End If If 钢筋直径<= 最小搭接直径Then If 搭接类别= "腰筋G" Then DJ = 钢筋直径* 1.5: x = 1 End If If 搭接类别= "搭接100%" Or 搭接类别= "构造柱" Then DJ = MAX(锚固* 1.6, 30, 0, 0) * a: X1 = 1 End If If 搭接类别= "Q" Or 搭接类别= "Z" Or 搭接类别= "搭接25%" Then DJ = MAX(锚固* 1.2, 30, 0, 0) * a: X2 = 1 End If If x + X1 + X2 = 0 Or 搭接类别= "" Then DJ = MAX(锚固* 1.4, 30, 0, 0) * a End If End If End Function Public Function MG(抗震级别As Single, 钢筋级别As Single, 砼号C As Single, 钢筋直径As Single) Dim j As Single Dim k As Single Dim g As Single If 钢筋直径>= 28 Then If 钢筋级别>= 2 Then j = 1.1 Else j = 1

EXCEL常见基本用法

EXCEL用法大全 2009年11月23日星期一09:31 01、如何在已有的单元格中批量加入一段固定字符？ 例如：在单位的人事资料，在excel中输入后，由于上级要求在原来的职称证书的号码全部再加两位，即要在每个人的证书号码前再添上两位数13，如果一个一个改的话实在太麻烦了，那么我们可以用下面的办法，省时又省力： 1）假设证书号在A列，在A列后点击鼠标右键，插入一列，为B列； 2）在B2单元格写入：="13"&A2后回车； 3）看到结果为13xxxxxxxxxxxxx了吗？鼠标放到B2位置，单元格的下方不是有一个小方点吗，按着鼠标左键往下拖动直到结束。当你放开鼠标左键时就全部都改好了。若是在原证书号后面加13则在B2单元格中写入：=A2&“13”后回车。 02、如何设置文件下拉窗口的最下面的最近运行的文件名个数？ 打开“工具”，选“选项”，再选“常规”，在“最近使用的文件清单”下面的文件个数输入框中改变文件数目即可。若不在菜单中显示最近使用的文件名，则将“最近使用的文件清单”前的复选框去掉即可。 03、在EXCEL中输入如“1-1”、“1-2”之类的格式后它即变成1月1日，1月2日等日期形式，怎么办？ 这是由于EXCEL自动识别为日期格式所造成，你只要点击主菜单的“格式”菜单，选“单元格”，再在“数字”菜单标签下把该单元格的格式设成文本格式就行了。 04、在EXCEL中如何使它象WORD一样的自动定时保存文件？ 点击“工具”菜单“自动保存”项，设置自动保存文件夹的间隔时间。如果在“工具”菜单下没有“自动保存”菜单项，那么执行“工具”菜单下“加载宏...”选上“自动保存”，“确定”。然后进行设置即可。 05、用Excel做多页的表格时，怎样像Word的表格那样做一个标题，即每页的第一行（或几行）是一样的。但是不是用页眉来完成？ 在EXCEL的文件菜单－页面设置－工作表－打印标题；可进行顶端或左端标题设置，通过按下折叠对话框按钮后，用鼠标划定范围即可。这样Excel就会自动在各页上加上你划定的部分作为表头。 06、在Excel中如何设置加权平均？ 加权平均在财务核算和统计工作中经常用到，并不是一项很复杂的计算，关键是要理解加权平均值其实就是总量值（如金额）除以总数量得出的单位平均值，而不是简单的将各个单位值（如单价）平均后得到的那个单位值。在Excel中可设置公式解决（其实就是一个除法算式），分母是各个量值之和，分子是相应的各个数量之和，它的结果就是这些量值的加权平均值。 07、如果在一个Excel文件中含有多个工作表，如何将多个工作表一次设置成同样的页眉和页脚？如何才能一次打印多个工作表？ 把鼠标移到工作表的名称处（若你没有特别设置的话，Excel自动设置的名称是“sheet1、sheet2、sheet3.......”），然后点右键，在弹出的菜单中选择“选择全部工作表”的菜单项，这时你的所有操作都是针对全部工作表了，不管是设置页眉和页脚还是打印你工作表。 08、EXCEL中有序号一栏，由于对表格进行调整，序号全乱了,可要是手动一个一个改序号实在太慢太麻烦，用什么方法可以快速解决？ 如果序号是不应随着表格其他内容的调整而发生变化的话，那么在制作EXCEL表格时就应将序号这一字段与其他字段分开，如在“总分”与“排名”之间空开一列，为了不影响显示美观，可将这一空的列字段设为隐藏，这样在调整表格（数据清单）的内容时就不会影响序号了。

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、使用方法

Excel自定义函数157个(精)

自定义函数功能 查看代码： 自定义函数取值范围如何设定 相当于VLOOKUP 吧，查询某一值第num 次出现的值 返回指定列数的列标 用指定字符替换某字符 从右边开始查找指定字符在字符串中的位置 将20040510数字格式，转换为2004－5－10的日期格式的函数工龄计算： 计算日期差，除去星期六、星期日的自定义函数 這是一個將英文字反轉的自定函數 关于个人所得税的 一个能计算是否有重复单元的函数 试编写数字金额转中文大写的函数 人民币大小写转换函数 获取区域颜色值: 获取活动工作表名的： 显示在“插入函数”对话框的“或选择类别”下拉列表中 复合函数

对工作表的第一列进行各种查询 序数词转换函数 获取最后一行行数的： 判断是否连接在线的函数 查找一字符串(withinstr在另一字符串中 从工作表第一行的标题文字以数字形式返回所在列号多工作表有条件求和 有的时候需要返回多个数值，那就是用返回数组吧Excel 自定义函数返回一组字符串 也来个返回指定列数的列标号自定义函数 返回 Column 英文字 查找指定列名的列数 文字格式的时间(分:秒转化为数字格式(秒 将"hh:mm:ss"格式的时分秒数转换成秒数 试编写金额中文大写转数字函数 身份证号码侦测自定义函数 显示公式的函数 为财务人员理帐查找用的 数值转换为字符地址

字符地址转换为数值 VB 中用的，虽然VBA 中也有一个Application.Wait 功能得到字符串实际的长度（以单字节记） 也做个个人所得税 18位身份证最后一位有效性验证 计算符合maturity condition的拆解金额 相当于多个vlookup 函数相加， 判断表是否存在的函数 我这个是角度转弧度的，以供大家参考 比较相同的字符串 對選定的陣列進行排序 取得指定月份天數 排序工作表活頁薄 統計陣列中非重復數據個數 摘取子字符串自定义函数 根据列表返回列序号 查找某值在某区域第n 次出现时对应列的值 刪除當前工作表中的全部超連接。 取得相近數據

史上最全面的计算简体繁体汉字笔画的VBA自定义函数及汉字笔画字库

Function char_wordnum(my_char_word) '史上最权威最全面的计算简体繁体汉字笔画的VBA自定义函数及汉字笔画字库 'from bdQuaker 20140619 '笔画数据库来自在线新华字典 https://www.sodocs.net/doc/393213796.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) = "吖阨伌安犴仰朳玐百阪邦闭毕朼夶邠冰并伧艸奼汊扱扠犲芆忏产辿伥场仯伡尘臣丞成朾弛池驰伬吃充冲虫岀汌舛传闯创朿次此汆伜存忖邨达汏刐伔凼圵当乭导氘朷" + _

Excel自定义求农历函数――nongli(公历日期,显示序号)

Option Base 1 Dim rq As Integer '日期 Dim y As Date '农历正月月初一的阳历日期 Dim yts As Variant '农历每月的天数 Dim yy(2) As Integer '农历闰月数、阳历闰年数（闰年为1，不闰年为0） Dim nl(3, 385) As String '阳历日期字符串、农历日期字符串、农历闰月字符串 Function NONGLI(glrq As Date, nlr As Integer) Dim X As Integer, i As Integer, k As Integer, n1 As Integer, n2 As Integer X = Year(glrq) If X < 1900 Or glrq > #1/28/2101# Then NONGLI = "？" Exit Function End If '1、将X年的阴阳历等，通过运行程序2，装入数组 If X < 2021 Then Call Array1(X, n1, glrq) If X > 2020 Then Call Array2(X, n1, glrq) '2、查找阳历日期所在数组的序号rq di2bu: rq = 0 If X = 1899 Then rq = Day(glrq)

Else For i = 1 To n1 If nl(1, i) = glrq Then rq = i: Exit For Next i End If '3、填写"农历日期"(包括节日、纪念日) Dim nongli1$, yr$, yuefen$, yf$, rizi$, rz$ Dim jr1 As String, jr2 As String, jr3 As String nongli1 = nl(2, rq)'农历日期以"2014-2-1"或"2014-闰9-1"的形式表示 yr = Strings.Right(nongli1, Strings.Len(nongli1) - 5) '农历日期以"2-1"或"闰9-1"形式表示yuefen = Strings.Left(yr, Strings.InStrRev(yr, "-") - 1) '农历的月份以"2"或"闰9"形式表示rizi = Strings.Right(yr, Strings.Len(yr) - Strings.InStrRev(yr, "-")) '农历的日子以"2"形式表示Dim yuefenB As Variant, yfB As Variant yuefenB = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, "闰2", "闰3", "闰4", "闰5", "闰6", "闰7", "闰8", "闰9", "闰10", "闰11", "闰12") yfB = Array("正月", "二月", "三月", "四月", "五月", "六月", "七月", "八月", "九月", "十月", "冬月", "腊月", "闰二月", "闰三月", "闰四月", "闰五月", "闰六月", "闰七月", "闰八月", "闰九月", "闰十月", "闰冬月", "闰腊月") For i = 1 To 23'农历的月份以汉字形式表示 If yuefen = yuefenB(i) Then yf = yfB(i): Exit For Next i Dim rzB As Variant

“四舍六入五单双”利用VBA自定义函数解决

利用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既可以是单元格,也可以是输入的数值),回车结果就出来了。如果出现

VSTO4.0创建EXCEL自定义函数

前段时间装了个visual studio 2010，试着用里面的VSTO4.0，但是对如何生成一个自定义函数始终搞不明白（之前也看了《VSTO开发指南》，但觉得里面所讲的东西太泛了，而且版本不一样，形式也改变了不少），终于在网上看到有人写出一个完整的过程（原文请看https://www.sodocs.net/doc/393213796.html,/brooks-dotnet/archive/2011/01/16/1936871.html），但在实操中还是有不少问题，但经过多次尝试，终于解决了所遇到的问题，现在我就根据原文的内容以及建立过程中所遇到的问题，重新整理后讲述建立一个自定义函数的过程。 一、启动VS2010，（这里尝试着用C#来编写）新建一个类库，填好名称之后按确定，开始编码。 二、进入编程界面后，先引用必须的类库 using System; using System.Collections.Generic; using System.Linq; using System.Text; using System.Runtime.InteropServices; using Microsoft.Win32; using Microsoft.Office.Interop.Excel 设置GUID及COM的一些特性 [Guid("A4AAE79B-9587-4014-BABB-966C5DF76C83")] [ClassInterface(ClassInterfaceType.AutoDual),ComVisible(true)] 如图示：

Guid这个标识码可用LINQPad程序来获取（可从https://www.sodocs.net/doc/393213796.html,/下载） 在类中，除了有函数主体外，还必须有注册及注销时的行为语句，所以必须添加以下语句：#regi on COM Related [ComRegisterFunction] public static void Regi sterFunction(Type type) { Registry.ClassesRoot.CreateSubKey(GetSubKeyName(type, "Programmable")); var key = Registry.ClassesRoot.OpenSubKey(GetSubKeyName(type, "InprocServer32"), true); key.SetValue("", Environment.SystemDirectory + @"\mscoree.dll", Regi stryValueKind.String); } [ComUnregisterFunction] public static void Unregi sterFuncti on(Type type) { Registry.ClassesRoot.DeleteSubKey(GetSubKeyName(type, "Programmable"), false); } private static string GetSubKeyName(Type type, string subKeyName)

excel中161个VBA_自定义函数(超级实用)(精)

目录 '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自定义函数实例集锦文章

在Excel中自定义函数 Excel函数虽然丰富，但并不能满足我们的所有需要。我们可以自定义一个函数，来完成一些特定的运算。下面，我们就来自定义一个计算梯形面积的函数： 1.执行“工具→宏→Visual Basic编辑器”菜单命令（或按“Alt+F11”快捷键），打开Visual Basic编辑窗口。 2.在窗口中，执行“插入→模块”菜单命令，插入一个新的模块——模块1。 3.在右边的“代码窗口”中输入以下代码： Function V（a,b,h） V = h*（a+b）/2 End Function 4.关闭窗口，自定义函数完成。 以后可以像使用内置函数一样使用自定义函数。 提示：用上面方法自定义的函数通常只能在相应的工作簿中使用。

经验分享Excel中自定义函数实例剖析 一、认识VBA 在介绍自定义函数的具体使用之前，不得不先介绍一下VBA，原因很简单，自定义函数就是用它创建的。VBA的全称是Visual Basic for Ap pli ca tion，它是微软最好的通用应用程序脚本编程语言，它的特点是容易上手，而且功能非常强大。 在微软所有的Office组件中，如Word、Access、Powerpoint等等都包含VBA，如果你能在一种Office组件中熟练使用VBA，那么在其它组件中使用VBA的原理是相通的。 Excel中VBA主要有两个用途，一是使电子表格的任务自动化；二是可以用它创建用于工作表公式的自定义函数。 由此可见，使用Excel自定义函数的一个前提条件是对VBA基础知识有所了解，如果读者朋友有使用Visual Basic编程语言的经验，那么使用VBA时会感觉有很多相似之处。如果读者朋友完全是一个新手，也不必太担心，因为实际的操作和运用是很简单的。 二、什么时候使用自定义函数？ 有些初学Excel的朋友可能有这样疑问：Excel已经内置了这么多函数，我还有必要创建自己的函数吗？ 回答是肯定的。原因有两个，它们也正好可以解释什么时候使用Excel自定义函数的问题。 第一，自定义函数可以简化我们的工作。 有些工作，我们的确可以在公式中组合使用Excel内置的函数来完成任务，但是这样做的一个明显缺点是，我们的公式可能太冗长、繁琐，可读性很差，不易于管理，除了自己之外别人可能很难理解。这时，我们可以通过使用自定义函数来简化自己的工作。 第二，自定义函数可以满足我们个性化的需要，可以使我们的公式具有更强大和灵活的功能。 实际工作的要求千变万化，仅使用Excel内置函数常常不能圆满地解决问题，这时，我们就可以使用自定义函数来满足实际工作中的个性化需求。

Excel VBA编程 调用函数

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所示。 输入 单击

用VBA编写Excel自定义的累加函数

用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，能完成的功能就大不一样。

原创—EXCEL VBA SPC自定义函数包括CPK PPK CP……

'################## 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自定义函数方法拼音

Excel自定义函数方法： 1.启动Excel 2003 （其它版本请仿照操作） ，打开相应的工作表； 2.执行“工具→宏→Visual Basic编辑器”命令（或者直接按“Alt+F11”组合键），进入Visual Basic编辑状态； 3.执行“插入→模块”命令，插入一个新模块。再双击插入的模块，进入模块代码编辑 状态； 4.将代码输入其中； 5.代码输入完成后，关闭 V isual Basic 编辑窗口，返回 Excel 编辑状态； 6. 自定义函数就可以用了，如：选中 D2 单元格，输入公式： =getpy(A2) 。 有极个别的汉字不能转换，手动就可以了！很方便了。 Function pinyin (p As String) As String i = Asc(p) Select Case i Case -20319 To -20318: pinyin =“a” Case -20317 To -20305: pinyin =“ai” Case -20304 To -20296: pinyin =“an” Case -20295 To -20293: pinyin =“ang” Case -20292 To -20284: pinyin =“ao” Case -20283 To -20266: pinyin =“ba” Case -20265 To -20258: pinyin =“bai” Case -20257 To -20243: pinyin =“ban” Case -20242 To -20231: pinyin =“bang” Case -20230 To -20052: pinyin =“bao”

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以后的语句。