解决Excel VBA时间毫秒不准确的问题
我使用Excel时间格式“hh：mm：ss.000”，并通过VBA连续添加50ms的单元格：
Dim dblTimestamp As Double dblTimestamp = Selection.Value ' origin timestamp ' Setup base time increment of 50ms over 20 minutes For i = 1 To Selection.Rows.Count Selection.Rows(i).Value2 = dblTimestamp + (2# / (864000# * 4#)) dblTimestamp = dblTimestamp + (2# / (864000# * 4#)) Next i 所以你可以在2015年5月23日看到原点时间，事情开始正常：
5/23/2015 05:30:00.000 05:30:00.050 05:30:00.100 05:30:00.150 05:30:00.200 05:30:00.250
问题是精度/舍入误差在几分钟后（〜1840行）开始显示：
05:31:32.100 05:31:32.149 05:31:32.199 05:31:32.249
然后20分钟后更为明显：
05:49:59.793 05:49:59.843 05:49:59.893 05:49:59.943 05:49:59.993
我可以使用其他数据types进行计算，还是需要暴力破解，每1840行增加一个毫秒？ 我更喜欢一个解决scheme，当我将时间步长改为200ms时也适用
这应该做的伎俩。 请注意，我删除了“select”参考，而是使用“Now（）”作为时间戳，并将值放置在单元格A2到A20000中。 在function上，你可以把所有的帮助者的东西合并到一个单一的舍入函数中，但我devise的方式是感受更多的面向对象，并展示一个更具适应性的范例。 希望这可以帮助。
'A type used to store time data Type TimeHelper MS As Double BaseTime As Double End Type 'Value to use as millisecond Const MilSec = 1 / 86400000 Sub Test() Dim t As Double t = Now() Dim step As Double step = 75 Dim TH As TimeHelper For i = 2 To 200000 t = t + step * MilSec TH = GetTimeHelper(t) t = RoundMS(TH, step) Cells(i, 1).Value2 = t Next i End Sub Function GetTimeHelper(t As Double) As TimeHelper x = t 'Unrounded Hours x = (x - Round(x, 0)) * 24 'Unrounded Minutes x = (x - Round(x, 0)) * 60 'Seconds as Milliseconds GetTimeHelper.MS = (x - Round(x, 0)) * 60000 'Time rounded down to nearest minute by removing millisecond value GetTimeHelper.BaseTime = t - (GetTimeHelper.MS * MilSec) End Function Function RoundMS(TH As TimeHelper, m As Double) 'Construct a time from basetime and milliseconds 'with milliseconds rounded to nearest multiple of m RoundMS = TH.BaseTime + (Round(TH.MS / m, 0) * m) * MilSec End Function
添加完成后，您需要将date值舍入。 Exceldate以数字forms存储在引擎盖下，时间以十进制表示。 例如，42249.6282730324是2015年2月9日（小数点左边）15：04：43.550（小数点右边）所以你需要舍入这个数字。 这里有一个很好的post，展示了如何使用INT，CEILING和MODfunction来实现这个function。 http://exceluser.com/formulas/roundtime.htm 。
其实我只是决定检查每行后面的文本值，看它是否以9结尾，然后在必要时添加一个毫秒：
Dim dblTimestamp As Double dblTimestamp = Selection.Value ' origin timestamp ' Setup base time increment of 50ms over 20 minutes For i = 1 To Selection.Rows.Count Selection.Rows(i).Value2 = dblTimestamp + (2# / (864000# * 4#)) dblTimestamp = dblTimestamp + (2# / (864000# * 4#)) ' check to see if previous value ended in 9 indicating loss of precision ' eg 05:30:00.999 instead of 05:30:01.000 If Right(Selection.Rows(i).Cells(1).Text,1)="9") Then dblTimestamp = dblTimestamp + (1#/86400000#) ' add 1 ms Selection.Rows(i).Value2 = dblTimestamp End If Next i
这对我的情况已经足够好了，但P57的答案对于其他情况应该还是够好的。