按标题选择一列并使用宏 ROUND 到最近的一分钱

Posted 2023-02-24

【中文标题】按标题选择一列并使用宏 ROUND 到最近的一分钱

【英文标题】：Select a column by header and ROUND to nearest penny using macro

【发布时间】：2018-09-04 16:49:53

【问题描述】：

我需要使用宏四舍五入到最接近的一分钱。我已经通过当前设置的宏（参见下面的代码）获得了“舍入”功能，以显示一个弹出窗口，供用户手动选择要舍入的数据。

但是，我希望宏自动选择标题为“FEE RATE”的列的整个数据填充范围（仅在填充数据的地方 - 这将是不同的列和不同的行数）并应用ROUND 函数：ROUND(DATA,2)。

Dim Rng As Range
Dim WorkRng As Range
Dim xNum As Integer
On Error Resume Next
xTitleId = "ROUND Formula"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Use Mouse to select entire FEE RATE column, then click on OK", xTitleId, WorkRng.Address, Type:=8)
For Each Rng In WorkRng
Rng.Value = Application.WorksheetFunction.Round(Rng.Value, 2)
Next

【问题讨论】：

docs.microsoft.com/en-us/office/vba/api/excel.range.end

【参考方案1】：

这是一种方法，使用 Find 来查找标题（假设它在第 1 行），然后假设范围是一直向下的下一个单元格。如果您只有一个条目，您可能需要从底部开始工作。

您也可以使用 Evaluate 来避免循环，尽管它可能会带来边际收益。

Sub x()

Dim rFind As Range
Dim Rng As Range
Dim WorkRng As Range

Set rFind = Rows(1).Find(What:="FEE RATE", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
    Set WorkRng = Range(rFind.Offset(1), rFind.End(xlDown))
    'For Each Rng In WorkRng
    '    Rng.Value = Application.WorksheetFunction.Round(Rng.Value, 2)
    'Next
    WorkRng = Evaluate("IF(" & WorkRng.Address & "="""","""",ROUND(" & WorkRng.Address & ",2))")
End If

End Sub

【讨论】：

我没有让这段代码工作。有什么我需要调整的吗？我对宏观写作还是很陌生。谢谢！

您能详细说明一下吗？听起来好像“费率”可能找不到。是在第 1 行吗？尝试使用 F8 单步执行代码。

当我运行代码时，我没有收到任何错误，也没有中断。它似乎什么也没做。我尝试过使用 F8-same 单步执行代码。没结果。没有错误。

那么 If 行会发生什么？如果 rFind 为 Nothing，则代码将结束。尝试更改为 Lookat:=xlPart 或检查尾随或前导空格。

好的，在更改为 Lookat:=xlPart 后，这正在工作。非常感谢。