在UDF中使用Excel的舍入轮次为1到0

时间:2016-01-21 01:26:26

标签: excel vba excel-vba spreadsheet udf

总而言之,我工作的地方通过时钟的象限来衡量时间。例如,1.1是1小时0-15分钟,1.2小时15-30分钟,1.3小时30-45分钟。没有1.4因为1.4当然等于2。

我想创建一个excel表,它会自动在这个系统下添加我的时间,所以我编写了这个UDF来转换时间,将十进制值分开并乘以2.5得到一个正常的十进制值(.1 = .25 ,.2 = .5,.3 = .75)然后在结尾处除以2.5以转换回我雇主的格式。我知道可以使用excel的现有公式来完成它,但是它有点混乱,说实话我现在太顽固了,不能让它现在这样。

如果您查看下面的屏幕截图,您会看到该功能适用​​于除最终每周总列之外的所有列,因为某些原因显示39.4而不是40(同样这两个值在技术上是等效的,但是程序由于某种原因,没有将.4转换为1。)

http://i.imgur.com/yxOvlkP.png

这是完整的代码。当剩余部分恰好等于1时,似乎会发生这个问题(为简单起见,只需要输入两个以.2结尾的值),然后在某种程度上将其四舍五入为零。

Function newMath(week As Range) As Double

Dim time As Variant
Dim remainder As Double
Dim wholeTime As Double

remainder = 0
wholeTime = 0

For Each time In week
  remainder = remainder + ((time - WorksheetFunction.RoundDown(time, 0)) * 2.5)   'Separate and sum up decimal values
  wholeTime = wholeTime + WorksheetFunction.RoundDown(time, 0)                    'Separate and sum up whole hours
Next time

'Problem occurs at this point when remainder = 1
'WorksheetFunction.RoundDown(remainder, 0) will equal 0 below even when 1 should round down to 1

wholeTime = wholeTime + WorksheetFunction.RoundDown(remainder, 0)                 'Add the whole remainder hours to whole time
remainder = (remainder - WorksheetFunction.RoundDown(remainder, 0)) / 2.5         'Get decimal value of remainder and convert back to quadrant

newMath = wholeTime + remainder

End Function

不知何故当余数等于1 excel的向下舍入函数似乎将其舍入为0。

这意味着以下行不会将1添加到整数次:

wholeTime = wholeTime + WorksheetFunction.RoundDown(remainder, 0)  

并且该行将返回1,当它不应该(除了.4来自的地方)时将其除以2.5:

remainder = (remainder - WorksheetFunction.RoundDown(remainder, 0)) / 2.5 

我不确定发生了什么,或者为什么excel将我的余数1舍入为0,如果这确实是问题的话。我感谢任何帮助,如果您需要更多信息,请告诉我。谢谢!

2 个答案:

答案 0 :(得分:0)

这是一种略微不同的做事方式,以便不用0.3999999代替4.注意我使用的VBA Int函数应该比workheetfunction.roundown(n)更快地执行,0)。

通过乘以time * 10,然后使用Mod函数将最后一位数相加,我们可以进行整数运算,直到转换回最终结果为止。

另请注意,以下例程仅适用于正数。如果您的时间表上可能有负数,则应使用Fix代替Int

Option Explicit

Function newMath(week As Range) As Double

Dim time As Range
Dim remainder As Variant
Dim wholeTime As Long

remainder = 0
wholeTime = 0

For Each time In week
    wholeTime = wholeTime + Int(time)
    remainder = remainder + (time * 10) Mod 10
Next time

'Problem occurs at this point when remainder = 1
'WorksheetFunction.RoundDown(remainder, 0) will equal 0 below even when 1 should round down to 1

wholeTime = wholeTime + Int(remainder / 4)               'Add the whole remainder hours to whole time
remainder = ((remainder / 4) - Int(remainder / 4)) / 2.5  'Get decimal value of remainder and convert back to quadrant

newMath = wholeTime + remainder

End Function

答案 1 :(得分:0)

试试这段代码:

Function newMath(Rng As Range) As Double

    Dim CL As Range
    Dim hs As Long, hs1 As Long
    Dim ms As Double, ms1 As Double, ms2 As Double

    For Each CL In Rng
     hs = hs + Fix(CL.Value)
     ms = ms + CL.Value
    Next

    ms1 = Round((ms - hs), 1)
    hs1 = Fix(ms1 / 0.4)
    ms2 = ms1 - (hs1 * 0.4)
    newMath = hs + hs1 + ms2

End Function