如何创建一个宏，为一个范围内的公式添加前缀和后缀？

Question

我希望创建一个从用户请求“前缀”和“后缀”的宏，以及一个范围。前缀将放置在每个公式的前面，而后缀将放置在整个范围内的每个公式的末尾。例如，如果A1包含带有前缀ABC和后缀=LEFT(的{​​{1}}，则A1中的公式应从,1)更改为ABC，因此仅显示=LEFT(ABC,1)。

为此提供用户界面的最佳方式是通过表单。我们称之为“宏包装器”：

这就是它应该在行动中的样子：

以下是A和cmdApply按钮的VBA代码：

cmdCancel

但是，当我编译上面的内容时，我收到“运行时错误'1004'：应用程序定义或对象定义的错误”。

我尝试将Private Sub cmdApply_Click() Dim DataValue As Range For Each DataValue In Range(redtSelectRange) If Left(DataValue.Formula, 1) = "=" Then DataValue.Formula = "=" & _ Trim(txtBefore.Text) & _ Right(DataValue.Formula, Len(DataValue.Formula) - 1) & _ Trim(txtAfter.Text) Else DataValue.Formula = "=" & _ Trim(txtBefore.Text) & _ DataValue.Formula & _ Trim(txtAfter.Text) End If Next DataValue End Sub Private Sub cmdCancel_Click() Unload Me End Sub 条件缩短为cmdApply m I语句：

If

甚至Intermediate窗口显示范围中第一个条目的正确（预期）输出：

Private Sub cmdApply_Click()
Dim DataValue As Range

For Each DataValue In Range(redtSelectRange)
  DataValue.Formula = "=" & _
    Trim(txtBefore.Text) & _
    IIf(Left(DataValue.Formula, 1) = "=", Right(DataValue.Formula, Len(DataValue.Formula) - 1), DataValue.Formula) & _
    Trim(txtAfter.Text)
  End If
Next DataValue

End Sub

我应该在代码中更改为每个范围的公式正确添加/插入前缀/后缀？

Answer 1

根据您的代码和图片中的示例，您的.Formula作业将最终成为：

==round(1.2,0)

修复它：

Private Sub cmdApply_Click()
Dim DataValue As Range

For Each DataValue In Range(redtSelectRange)
  If Left(txtBefore.Text, 1) = "=" Then
    DataValue.Formula = Trim(txtBefore.Text) & _
      Right(DataValue.Formula, Len(DataValue.Formula) - 1) & _
      Trim(txtAfter.Text)
  Else
    DataValue.Formula = "=" & _
      Trim(txtBefore.Text) & _
      DataValue.Formula & _
      Trim(txtAfter.Text)
  End If
Next DataValue

End Sub

Answer 2

试试这个：

Private Sub cmdApply_Click()
  Dim DataValue As Range
  For Each DataValue In Range(redtSelectRange)
    'Your code had an additional "=" leading into this string below but in your 
    'example, there was already a leading "=" in the txtBefore.Text. If you
    'don't know if it will always have a leading "=" then add some code to       
    'make sure only 1 is included
    If Left(DataValue.Formula, 1) = "=" Then
      DataValue.Formula = Trim(txtBefore.Text) & _
      Right(DataValue.Formula, Len(DataValue.Formula) - 1) & _
      Trim(txtAfter.Text)
    Else
      DataValue.Formula = "=" & _
      Trim(txtBefore.Text) & _
      DataValue.Formula & _
      Trim(txtAfter.Text)
    End If
  Next 'DataValue isn't required here
End Sub

Answer 3

Sub AddText_Prefix_And_Suffix()


Dim rng As Range
Dim Workrng As Range
Dim Prefix As String
Dim Suffix As String


On Error Resume Next
xTitleId = "Range Selector"
Set Workrng = Application.Selection
Set Workrng = Application.InputBox("Range", xTitleId, Workrng.Address, Type:=8)
Prefix = Application.InputBox("Enter Prefix", xTitleId, "Prefix", Type:=2)
Suffix = Application.InputBox("Enter Suffix", xTitleId, "Suffix", Type:=2)


    If Prefix = "False" And Suffix = "False" Then
    MsgBox "User cancelled"
    Else
    For Each rng In Workrng
    rng.Value = Prefix & rng.Value
    rng.Value = rng.Value & Suffix
    Application.ScreenUpdating = False
    Next
    End If

MsgBox "Done"
End Sub

您可以使用此简化版本，并获得与预期相同的结果。

此代码将要求用户选择要操作的范围，然后再次提示后缀和前缀，从而将现有数据仅更改为选定的范围

希望它对某人有帮助