如何創建一個宏，為一個范圍內的公式添加前綴和后綴？

Question

我希望創建一個宏來請求用戶的“前綴”和“后綴”，以及一個范圍。 前綴將放置在每個公式的前面，而后綴將放置在整個范圍內的每個公式的末尾。 例如，如果A1包含帶前綴=LEFT(和后綴,1) ABC ，則A1中的公式應從ABC更改為=LEFT(ABC,1) ，因此僅顯示A

為此提供用戶界面的最佳方式是通過表單。 我們稱之為“宏包裝器”：

這就是它應該在行動中的樣子：

這是我的cmdApply和cmdCancel按鈕的VBA代碼：

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

但是，當我編譯上面的內容時，我收到“運行時錯誤'1004'：應用程序定義或對象定義的錯誤”。

我嘗試將cmdApply條件縮短為I mmediate If語句：

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

甚至中間窗口顯示范圍中第一個條目的正確（預期）輸出：

?Trim(txtBefore.Text) & IIf(Left(DataValue.Formula, 1) = "=", Right(DataValue.Formula, Len(DataValue.Formula) - 1), DataValue.Formula) & trim(txtAfter.Text)
=round(1.2,0)

我應該在代碼中更改為每個范圍的公式正確添加/插入前綴/后綴？

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

您可以使用此簡化版本，其結果與您期望的相同。

此代碼將要求用戶選擇要操作的范圍，之后它將再次提示輸入后綴和前綴，使用現有數據將僅更改為選定范圍

希望它可以幫助某人