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方法的变体

适用于当前选择中的所有公式单元格

使用数组，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

第二次错字＆＃34; =round＆＃34;函数输入为＆＃34; =Rround＆＃34;。一旦用2轮而不是1轮进行修改，这个过程对我来说非常有用。我可以添加另一个if语句来检查是否已经存在＆＃34; =round＆＃34;公式，以防止某人在一轮内运行不止一次或四舍五入。

的Darryl

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 =＆＃34; round（＆＃34;＆amp; mid（n.formula，2,100）＆amp;＆＃34;，1）＆＃34; 接下来

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

Answer 6

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

使用鼠标
输入所需的位数而不是编辑代码
输入通过更改 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

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

6 个答案: