使用VBA将Round函数插入当前单元格
我正试图让Round函数插入已经有公式的单元格中。
例如，如果单元格A1具有公式=b1+b2 ，则在使用此macros之后，我希望单元格内容读取=Round(b1+b2,) 。 每个单元格中的公式不一样，所以b1+b2部分必须是任何东西。
我所能得到的是：
Sub Round() Activecell.FormulaR1C1 = "=ROUND(b1+b2,)" End Sub
所以我真的想找一些方法来获取选定单元格中的公式，然后使用VBA编辑这些内容。 我无法在任何地方find答案。
这个怎么样？
Sub applyRound(R As Range) If Len(R.Formula) > 0 Then If Left(R.Formula, 1) = "=" Then R.Formula = "=round(" & Right(R.Formula, Len(R.Formula) - 1) & ",1)" End If End If End Sub
这是根据我在另一个论坛上写的代码 ，brettville的方法的一个变种
- 适用于当前select的所有公式单元格
-
使用数组，SpecialCells和string函数来优化速度。 如果你有很多单元，遍历范围可能会很慢
Sub Mod2() Dim rng1 As Range Dim rngArea As Range Dim i As Long Dim j As Long Dim X() Dim AppCalc As Long On Error Resume Next Set rng1 = Selection.SpecialCells(xlFormulas) On Error GoTo 0 If rng1 Is Nothing Then Exit Sub With Application AppCalc = .Calculation .ScreenUpdating = False .Calculation = xlCalculationManual End With For Each rngArea In rng1.Areas If rngArea.Cells.Count > 1 Then X = rngArea.Formula For i = 1 To rngArea.Rows.Count For j = 1 To rngArea.Columns.Count X(i, j) = "=ROUND(" & Right$(X(i, j), Len(X(i, j)) - 1) & ",1)" Next j Next i rngArea = X Else rngArea.Value = "=Rround(" & Right$(rngArea.Formula, Len(rngArea.Formula) - 1) & ",1)" End If Next rngArea With Application .ScreenUpdating = True .Calculation = AppCalc End With End Sub
在第二个“ =round ”function上的错字被键入为“ =Rround ”。 一次修改2次，而不是1次，这个过程对我来说很好。 我可以在另一个if语句中添加一个if语句来检查是否已经存在一个“ =round ”公式来防止某个人在一轮内运行多次或四舍五入。
达里尔
完整的修改程序将是这样的
Sub Round_Formula() Dim c As Range Dim LResult As Integer Dim leftstr As String Dim strtemp As String Set wSht1 = ActiveSheet Dim straddress As String Dim sheet_name As String sheet_name = wSht1.Name 'MsgBox (sheet_name) straddress = InputBox(Prompt:="Full cell Address where to insert round function as D8:D21", _ Title:="ENTER Address", Default:="D8:D21") With Sheets(sheet_name) For Each c In .Range(straddress) If c.Value <> 0 Then strtemp = c.Formula 'MsgBox (strtemp) LResult = StrComp(Left(strtemp, 7), "=ROUND(", vbTextCompare) 'MsgBox ("The value of LResult is " & LResult) If LResult <> 0 Then 'c.Formula = "=ROUND(" & Right(c.Formula, Len(c.Formula) - 1) & ",2)" c.Formula = "=ROUND(" & Right(c.Formula, Len(c.Formula) - 1) & ",0)" End If End If Next c End With End Sub
尝试这个
对于select的每一个n。formulaula =“round（”＆mid（n.formula，2,100）＆“，1）”Next n
我假定您现有的公式长度小于100个字符，灵敏度为1.您可以更改这些值