我在一家大型公司工作,该公司在其财务报表中提供舍入数字。当然,舍入数字并不总是等于总数。我希望将最接近$ 0.50的组件编号向上或向下舍入,以使列等于总数。
例如,如果我有数字5.43,4.26和6.32,它们总共16.01。圆形,它们将分别为5,4和6,总数将为15.我希望将总数舍入为16,最接近$ X.50以绕过必要的方式。在这种情况下,它将是5.43舍入到6而不是5.
T.M.为我编写了以下代码。它适用于他的机器,但不适用于我的机器。他正在使用 Excel 2010 ,而我正在使用 Excel 2013 。每当我尝试执行代码时,都会出现错误,表示
编译错误:参数数量错误或属性分配无效。
单击“确定”按钮后,调试器会以蓝色突出显示单词Format
。突出显示的单词Format
位于第I部分c)中End If
命令之前的代码行中。
当我尝试测试代码时,我使用的是870金额的列,总计的总金额是实际总额的21.44美元。这意味着我需要将870个数字中的21个或22个用“错误”方式四舍五入。如果有人能提出解决方案,我将非常感激。谢谢!
Sub MurrayRound()
'
' MurrayRound Macro
' Rounds Murray's figures for budget.
Dim s As String
Dim v, vx As Variant
Dim ii As Long
Dim total As Double, rounded As Double, diff As Double, diffrest As Double, cent As Double
Dim i As Long, j As Long, n As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Rick") ' << change to your sheet name
' --------------------------------------------------------------------
' I. Get data for normal roundings and code absolute cent differences
' --------------------------------------------------------------------
' (a) get last row in column B containing data ' (omitting last row with total sum!)
n = ws.Range("B" & ws.Rows.Count).End(xlUp).Row - 1 ' << subtract 1 if last sum row!
' (b) get values (col.B-data, col.C-D temp) to one based 2dim array
v = ws.Range("B2:D" & n).Value
total = Application.Sum(Application.Transpose(Application.Index(v, 0, 1)))
' (c) loop through array to round (items count n - 1, as omitting one title row!)
For i = 1 To n - 1
' round original values
v(i, 2) = WorksheetFunction.Round(v(i, 1), 0)
' convert absolute cent differences 1-100 to chr codes and add item no
v(i, 3) = Chr(64 + (0.51 - Abs(v(i, 2) - v(i, 1))) * 100) & Format(i, "0")
End If
' overwrite original data in col2 with rounded values col1, AFTER coding!
v(i, 1) = v(i, 2)
Next i
' --------------------------------------------------------------------
' II. Calculate 'fudge'
' --------------------------------------------------------------------
rounded = Application.Sum(Application.Transpose(Application.Index(v, 0, 2)))
diff = WorksheetFunction.Round(rounded - total, 0) ' resting difference
diffrest = diff
' --------------------------------------------------------------------
' III. 'Fudge' resting difference using Filter function
' --------------------------------------------------------------------
For j = 0 To 49 ' absolute cent differences 0 to 49
If diffrest = 0 Then Exit For ' escape if no diffrest left
s = Chr(64 + j) ' code differences from Chr(64)="A" to Chr(64+49)="q"
' (a) get zerobased 1-dim array via ' Filter function
vx = Filter(Application.Transpose(Application.Index(v, 0, 3)), s)
' (b) Adapt roundings nearest to .50, .49, to .99 cents (i.e. j = 0, 1 to 49)
For i = LBound(vx) To UBound(vx) ' loop through filter items
ii = Val("0" & Replace(vx(i), s, "")) ' get coded Item index from filter array
If ii <> 0 Then
If diffrest <> 0 Then ' remaining diffrest
cent = IIf(diffrest > 0, -1, 1) ' get fudge cent
v(ii, 1) = v(ii, 2) + cent ' << new value = rounded +/- 1 cent
diffrest = WorksheetFunction.Round(diffrest + cent, 0)
' check escape condition: no remaining diffRest
If diffrest = 0 Then Exit For
End If
End If
Next i
Next j
' --------------------------------------------------------------------
' IV. Write results
' --------------------------------------------------------------------
' (a) redim to one column only (items count n - 1, as omitting title row)
ReDim Preserve v(1 To n - 1, 1 To 1)
' (b) write back to B (or to ANY wanted column :-)
ws.Range("C2:C" & n).Value = v
End Sub