《四舍五入，奇进偶舍》 **
* 编制：dlys1019 **
* 日期：2004.11.10 **
* 入口参数: **
* X1：需要舍入的数 **
* X2：保留的小数位数 **
FUNCTION ROUNDX
PARA X1,X2
nAAA=INT(x1*10^(x2+1))
nBBB=INT(x1*10^x2)
DO case
CASE VAL(RIGHT(STR(nAAA),1))>5 .or. VAL(RIGHT(STR(nAAA),1))<5
RETURN ROUND(x1,x2)
CASE VAL(RIGHT(STR(nAAA),1))=5
IF MOD(nBBB,2)=1
RETURN (nBBB+1)/(10^x2)
ELSE
RETURN nBBB/(10^x2)
ENDIF
ENDCASE
* 例如：round(123.455,2)=123.46 **
* roundx(123.465,2)=123.46 **
VB学习----奇进偶舍函数
测量程序必用到的自己定义函数，在对测量数据处理结果都要用奇进偶舍原则来对结果进行处理。Public Function NNN(ByVal NM As Double, ByVal BB As Integer) As Double
Rem **** 奇进偶舍函数
Rem **** NM为需要奇进偶舍的变量，BB为NM这个变量需要保留的小数点后面的倍数，最多允许小数后10位
Dim BNM As Double
Dim c As Integer
Dim j As Integer
Dim k As Integer
Dim i As Double
c = Sgn(NM)  '** 符号函数
BNM = Abs(NM) '** 绝对值函数
i = (BNM * 10 ^ (BB + 1) + 10 ^ (-11) - 10 * Fix(BNM * 10 ^ BB + 10 ^ (-11)))
i = (Fix(i * 10 ^ 10)) / 10 ^ 10
j = Fix(BNM * 10 ^ BB + 10 ^ (-11)) - 10 * Fix(BNM * 10 ^ (BB - 1) + 10 ^ (-11))  '** 奇偶检校
If i > 5 Then
k = 1
ElseIf i < 5 Then
k = 0
ElseIf (i = 5 And j = 2 * Fix(j / 2)) Then
k = 0
Else
k = 1
End If
NNN = c * Fix(BNM * 10 ^ BB + k) / 10 ^ BB
End Function
供参考。。。。。
摘要：Excel是大家非常熟悉的应用软件，其使用非常方便。尤其是其强大的函数功能，为我们带来了极大方便，但有时我们为实现一项规定的功能，可能用到几个函数或者采用嵌套函数，这样应用起来，也不太方便；或者使用自定义公式进行计算，就没有现成的公式可用。可喜的是，我们可以创建自定义函数UDF(User—defined function)，它的运行与Excel中自带的函数完全相同。建立自定义函数有以下几个优点：建立自己特殊的功能和名称的函数；能将复杂的、嵌套的、多个原有的函数组合在一起，发挥更大的威力，使用、维护更加方便。
关键词：函数 水质 应用
  Excel是大家非常熟悉的应用软件，其使用非常方便。尤其是其强大的函数功能，为我们带来了极大方
便，但有时我们为实现一项规定的功能，可能用到几个函数或者采用嵌套函数，这样应用起来，也不太方便；或者使用自定义公式进行计算，就没有现成的公式可用。可喜的是，我们可以创建自定义函数UDF(User—defined function)，它的运行与Excel中自带的函数完全相同。建立自定义函数有以下几个优点：建立自己特殊的功能和名称的函数；能将复杂的、嵌套的、多
个原有的函数组合在一起，发挥更大的
威力，使用、维护更加方便。
  比如在水质计算中，高锰酸盐指数的计算公式非常繁琐，而且含必须将结果修约至0.1，还得考虑逢5奇进偶舍的问题。利用计算器逐步计算很是麻烦；在EXCEL中利用单元格引用计算稍有不注意，可能造成计算上差错，而且每次都得建立，很不方便。现在我们利用EXCEL自带的VBA编辑器建立自己的函数来解决这个问题。
  首先进入Excel，在[工具]→[宏]→[Visul Basic编辑器](也可按组合键[Alt+F11])，在“Visul Basic编辑器”中选择[插入]→[添加模块]，将模块名称改为“高锰酸盐指数浓度计算公式”，在代码窗口输入下列函数：
  Public Function CImn(C As Single, V0 As Single, V1 As Single, V2 As Single, V As Integer)
'；高锰酸盐指数计算公式
  Dim DotLocation As Integer '；定义小数点位置变量
'*************************************************************************
  CImn = ((((10 + V1) * 10 / V2 - 10) - (((10 + V0) * 10 / V2 - 10) * (100 - V) / 100))) * C * 8000 / V
'*************************************************************************
'；保留一位小数
'；当CIMN值小于1时，自动补上个位0
  If CImn < 1 Then
round函数有几个参数  CImn = 0 & CImn
  End If
'；确定小数点的位置
DotLocation = InStr(CImn, ".")
'；判断小数点后第二位是否为5
  If Mid(CImn, DotLocation + 2, 1) = 5 Then
  If Len(CImn) <= DotLocation + 2 And Mid(CImn, DotLocation + 1, 1) Mod 2 = 0 Then
  CImn = Left(CImn, DotLocation + 1) '；为5且5后没有数和5前一位为偶数，直接用round()函数修约
  Else
  CImn = Round(CImn, 1)
  End If
  Else
  CImn = Round(CImn, 1) '；不为5，直接用round()函数修约
  End If
  CImn = Format(Round(CImn, 1), "#0.0")
  End Function
  我们知道，Excel中函数都有一个说明用以帮助使用，我们也要给这个函数添加一个说明。在工具栏中选择“对象浏览器”(如图1)，选择我们所做“高锰酸盐指数浓度计算公式”模块，在其[右键]→[属性]中添加关于对这个函数的描述，这个描述将出现在Excel中关于函数的说明中，如果你要对软件保密的话，在“模块”上按右键，[VBAproject属性]→[保护中设置密码]，别人就看不到你的源程序了。
图1描述函数
  这时，退出，回到Excel界面，将这个文件另存为：类型为“Microsoft Excel加载宏”，在Excel 2003中，它会自动更改保存位置为“C:\Documents and Settings\wzwemc（电脑用户名）\Application Data\Microsoft\AddIns” (系统装在c:＼windows)，当然，你也可以把这个文件“高锰酸
盐指数浓度计算公式.xla”，直接复制到office＼library(office的安装路径下)，而在Excel 97中只能放在后一个位置。使用函数很简单，点击[工
具]→[加载宏]，在你创建的“高锰酸盐指数浓度计算公式”前打个勾，如图2。在单元格直接输入“=CImn()”，选中相应的参数即可(如图3)。是不是像Microsoft office提供的函数一样，很有点专业味道。
图2加载宏
图3使用自定义函数
  假如你把调用这个宏的Excel文件拷贝到别的机子上运行，会出现“当前所要打开的文档含有其他文档的链接，是否要使用其他工作簿中的改动更新当前工作簿”的提示，可以显示原先计算的数据，这是因为在Excel中的[工具]→[选项]→[重新计算]中，一般选中“保存外部链接数据”，但你不能重新计算，因为不能链接这个宏，别人机子上根本就没有这个函数。
  此外，我们还可以为“加载宏”添加相关说明，这样更有利于自定义函数的维护。(如图3)，到“高锰酸盐指数浓度计算公式.xla”，点击[右键]→[属性]→[摘要] (如图4)，在描述里添加所需内容来对函数进行相关描述，其中“标题”部分将出现在“加载宏”的方框中，“备注”部分将出现在下面的函数说明部分。这时再看看，够不够专业。在Excel 97中也可以在其右键属性中作相应更改。
[求助]四舍六入，奇进偶舍的函数，谁能给修改修改
Private Function GetNumber(f As Double, iPos As Integer) As String
Dim k As Integer
Dim s As String, s1 As String, s2 As String
Dim i As Double, k1 As Double, k2 As Double
s = CStr(f)
i = InStr(1, s, ".") '；查小数点的位置
'；检查是否需要进行处理
s1 = Mid(s, i + iPos + 1, 1)
s2 = Mid(s, i + iPos, 1)
k = Val(s1)
k2 = Val(s2)
If Len(s) - i < iPos Then
MsgBox "；小数位数不足，请人工检查"
End If
If Len(s) - i = iPos Then s1 = s
If Len(s) - i > iPos Then '；最后一位<5：舍去，>5：进位，=5：奇进偶舍
If k < 5 Then '；舍去
s1 = Left$(s, i + iPos)
ElseIf k > 5 Then '；进位
s1 = Mid(s, i + iPos, 1)
k = Val(s1)
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim(Str(k))
ElseIf k = 5 Then '；奇进偶舍
s1 = Mid(s, i + iPos, 1)
k = Val(s1)
k2 = Len(s) - i - iPos - 1
' Print Len(s); i; iPos
If k2 = 0 Then '；偶舍
If k Mod 2 = 0 Then
s1 = Left$(s, i + iPos)
Else '；奇进
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim$(Str(k))
End If
Else
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim$(Str(k))
End If
End If
End If
' s1 = Format(s1, "####0.000")
' Print s1
GetNumber = CStr(s1) '；送回处理后的数据
浅谈用EXCE中的自定义函数处理“四舍六入，奇进偶舍
”
王祖松
在水文计算中，大家常用到“四舍六入，奇进偶舍”来处理数据，但是在EXCE中只有“四舍五入”的函数命令（ROUND），非常不方便，本人在此利用EXCE自定义函数编写了一段小程序，仅供大家参考：
1.首先打开EXCE，选择
菜单“工具→宏→Visual Basic编辑器”命令(或按下键盘Alt+F11组合键)，打开Visual Basic窗口，在这里自进行自定义函数。
2. 进入Visual Basic窗口后，选择菜单“插入→模块”命令，于是得到“模块1”，在其中输入如下自定义函数的VBA程序：
Function jw(x, y) As Double
Dim ij As Double
x = x * (10 ^ y)
x1 = Int(x)
x2 = x - x1
x3 = x1 Mod 2
If x2 > 0.5 Then
x1 = x1 + 1
ElseIf x2 = 0.5 And x3 = 1 Then
x1 = x1 + 1
Else
x1 = Int(x)
End If
x1 = x1 * (10 ^ (-y))
jw = x1
End Function
3. 函数自定义完成后，选择菜单“文件→关闭并返回到Microsoft Excel”命令，返回到Excel工作表窗口。JW函数与EXCE自带的ROUND（四舍五入）函数使用方法完全一样。当结果数保留到小数位时，Y为大于0的任何整数；当结果数保留到个位时，Y为0；当结果数保留到十位、百位时，Y为-1、-2。
例如：在C2单元格中输入公式“=JW(123.456，2)”，回车后就看见123.46；在C3单元格中输入公式“=JW(123.454，2)”， 回车后就看见123.45；在C4单元格中输入公式“=JW(123.455，2)” ，回车后就看见123.46。如果在C5单元格中输入公式“=JW(123.454，0)”， 回车后就看见123；在C6单元格中输入公式“=JW(123.454，-2)”， 回车后就看见100。
4.通常自定义的函数只能在当前工作薄使用，如果该函数需要在其它工作薄中使用，则选择菜单“文件→另存为”命令，打开“另存为”对话框，选择保存类型为“Mir-cosoft Excel加载宏”，然后输入一个文件名，如“JW”单击“保存”后文件就被保存为加载宏。然后选择菜单“工具→加载宏”命令，打开“加载宏”对话框，勾选“可用加载宏”列表框中的“JW”复选框即可，单击“确定”按钮后，就可以在本机上的所有工作薄中使用JW这个自定义函数了。
5.如果想要在其它机器上使用该自定义函数，只要把上面的加载宏文件复制到其它电脑上加载宏的默认保存位置即可。   
本人曾在资料整编时，利用这个自定义函数，结合数组公式编写水位、流量、电功率、含沙量程序，校验资料时屡试屡爽，非常方便。至于数组公式的编写，在此就不必要多说了，因为大家在实际的运用中早已经得心应手了。
我在处理试验数据时现在有求。
代码如下：
=IF(RIGHT(INT(A36*10^(B36+1)),1)*1<5,INT(A36*10^B36)*10^(B36*-1),IF(
RIGHT(INT(A36*10^(B36+1)),1)*1>5,(INT(A36*10^B36)+1)*10^(B36*-1),IF(A36-INT(A36*10^(B36+1))*10^((B36+1)*-1)>0,(INT(A36*10^B36)+1)*10^(B36*-1),IF(MOD(RIGHT(INT(A36*10^(B36)),1)*1,2)=1,(INT(A36*10^B36)+1)*10^(B36*-1),INT(A36*10^B36)*10^(B36*-1)))))

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。