使用VBA将Round函数插入当前单元格

Question

我试图让Round函数更容易插入到已经包含公式的多个单元格中。

例如，如果单元格A1具有公式=b1+b2，则在使用此宏之后，我希望单元格内容读取=Round(b1+b2,)。每个单元格中的公式都不相同，因此b1+b2部分必须是任何东西。

我所能得到的就是：

Sub Round()

    Activecell.FormulaR1C1 = "=ROUND(b1+b2,)"     
End Sub

所以我真的想找到一些方法来获取所选单元格中的公式，然后使用VBA编辑这些内容。我无法在任何地方找到答案。

Answer 1

这个怎么样？

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

Answer 2

这是基于code I wrote on another forum的brettville方法的变体

1. 适用于当前选择中的所有公式单元格
2. 使用数组，SpecialCell和字符串函数来优化速度。如果你有很多单元格，循环范围可能会非常慢

   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

Answer 3

第二个“=round”功能上的错字被输入为“=Rround”。一旦用2轮而不是1轮进行修改，这个过程对我来说非常有用。我可以添加另一个if声明来检查是否已经有一个“=round”公式，以防止某人在一轮内运行不止一次或四舍五入。

达里尔

Answer 4

完整修改的程序将是这样的

    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

Answer 5

试试这个

对于选择中的每个n，N.formula =“round（”＆mid（n.formula，2,100）＆“，1）”Next n

我假设您现有公式的长度小于100个字符，灵敏度为1.您可以更改这些值

Answer 6

我已经改进了Sumit Saha提供的答案，以提供以下功能：

1. 使用鼠标选择范围或不同范围
2. 输入所需的位数而不是编辑代码
3. 输入通过更改iNum的行顺序选择的不同区域的位数，如中所述。

问候，

    Sub Round_Formula_EREX()
    Dim c As Range
    Dim LResult As Integer
    Dim leftstr As String
    Dim strtemp As String
    Set wSht1 = ActiveSheet
    Dim straddress As Range
    Dim iNum As Integer

    Set straddress = Application.Selection
    Set straddress = Application.InputBox("Range", xTitleId, straddress.Address, Type:=8)
    iNum = Application.InputBox("Decimal", xTitleId, Type:=1)

    For Each c In straddress
       If c.Value <> 0 Then
    strtemp = c.Formula

    LResult = StrComp(Left(strtemp, 7), "=ROUND(", vbTextCompare)

    If LResult <> 0 Then
    'If you want to enter different digits for different regions you have selected,
    'activate next line and deactivate previous iNum line.
    'iNum = Application.InputBox("Decimal", xTitleId, Type:=1)

     c.Formula = "=ROUND(" & Right(c.Formula, Len(c.Formula) - 1) & "," & iNum & ")"
      End If
     End If
    Next c

    End Sub