如果它们等于某物，则删除最后 3 个字符

Question

（不影响单元格中的字符级格式）

我已经发布了一个类似的问题，但不幸的是，我意识到我无法使用任何解决方案，因为它们都删除了单元格中的所有格式:(

我有一个替换各种文本字符串的代码。它看起来像这样（+ 更多的 IF）：

Sub Fix()
  Dim X As Long, Cell As Range
  For Each Cell In Selection
    For X = Len(Cell.Text) To 1 Step -1
      If Cell.Characters(X, 3).Text = ", ," Then Cell.Characters(X, 3).Text = ","
      If Cell.Characters(X, 3).Text = ", (" Then Cell.Characters(X, 3).Text = " ("
      If Cell.Characters(X, 3).Text = ", [" Then Cell.Characters(X, 3).Text = " ["
      If Cell.Characters(X, 3).Text = ", -" Then Cell.Characters(X, 3).Text = " -"
      If Cell.Characters(1, 3).Text = "abc" Then Cell.Characters(1, 3).Text = ""
    Next
  Next
End Sub

如果 abc 包含在所选单元格的开头，我的代码的最后一行将删除。

当abc 包含在所选单元格的末尾时，我正在寻找如何删除它。

但保留单元格中的所有原始格式（文本大小、颜色、粗体/斜体/下划线字母等）对我来说非常重要。

请记住，我是一个完全的初学者，我对编程一无所知。我从互联网上复制了上面的代码，只是更改了值。

提前感谢您的帮助。

Answer 1

这样的事情可能会起作用：

Sub FixData()
Dim X As Long, Y As Long, Cell As Range, FindChars As Variant, ReplaceChars As Variant, StartRemove As Variant, EndRemove As Variant
FindChars = Array(", ,", ", (", ", [", ", -") 'must have at least 2 elements, if you only have one then just put something it will never have like "zzzzzzzzzz"
ReplaceChars = Array(",", " (", " [", " -") 'must have at least 2 elements, if you only have one then just put something it will never have like "zzzzzzzzzz"
StartRemove = Array("something1", "somthingelse1") 'must have at least 2 elements, if you only have one then just put something it will never have like "zzzzzzzzzz"
EndRemove = Array("something2", "somthingelse2") 'must have at least 2 elements, if you only have one then just put something it will never have like "zzzzzzzzzz"
For Each Cell In Selection
    For Y = LBound(FindChars) To UBound(FindChars)
        If InStr(1, Cell.Text, FindChars(Y)) > 0 Then Cell.Characters(InStr(1, Cell.Text, FindChars(Y)), Len(FindChars(Y))).Delete
    Next
    For Y = LBound(StartRemove) To UBound(StartRemove)
        If Left(Cell.Text, Len(StartRemove(Y))) = StartRemove Then Cell.Characters(1, Len(StartRemove(Y))).Delete
    Next
    For Y = LBound(EndRemove) To UBound(EndRemove)
        If Right(Cell.Text, Len(EndRemove(Y))) = EndRemove Then Cell.Characters(Len(Cell) - Len(EndRemove(Y)) + 1, Len(EndRemove(Y))).Delete
    Next
Next
End Sub

根据此后的对话和更新以反映这些对话进行编辑。

此代码有 4 个数组，它首先遍历查找和替换数组以查找和替换任何实例。然后它遍历起始数组以仅查找开头的内容，最后循环结束数组以查找字符串末尾的任何内容。

使用cell.characters().delete 将删除这些字符而不改变其周围的单个字符格式。

Answer 2

替换字符（保留格式）

Option Explicit

Sub FixIt()

    Const NoC As Long = 3
    Const Special As String = "abc"
    Dim Source As Variant: Source = Array(", ,", ", (", ", [", ", -")
    Dim Target As Variant: Target = Array(",", " (", " [", " -")

    Dim Cell As Range
    Dim UB As Long: UB = UBound(Source)
    Dim i As Long, x As Long
    Dim Current As String

    For Each Cell In Selection
        Current = Cell.Characters(Len(Cell.Text) - NoC + 1, NoC).Text
        If Current = Special Then _
           Cell.Characters(Len(Cell.Text) - NoC + 1, NoC).Delete
        For x = Len(Cell.Text) - NoC + 1 To 1 Step -1
            GoSub replaceCurrent
        Next
    Next

    Exit Sub

replaceCurrent:
    Current = Cell.Characters(x, NoC).Text
    For i = 0 To UB
        If Current = Source(i) Then Current = Target(i): Exit For
    Next
    If i <= UB Then Cell.Characters(x, NoC).Text = Current
    Return

End Sub

Answer 3

如果要删除单元格的最后三个字符，如果它们是abc，那么：

之前：

代码：

Sub EasyAsABC()
    Dim s As String, L As Long
    With ActiveCell
        s = .Text
        L = Len(s)
        If Right(s, 3) = "abc" Then
            .Characters(L, 1).Text = ""
            .Characters(L - 1, 1).Text = ""
            .Characters(L - 2, 1).Text = ""
        End If
    End With
End Sub

之后：

Answer 4

由于所有字符串的长度都是 3，因此您只需调整循环：

For X = Len(Cell.Text) - 2 To 1 Step -1

只需添加如下一行：

If Cell.Characters(X, 3).Text = "abc" Then Cell.Characters(X, 3).Text = ""

这将使您查找abc 的最后一行变得多余并且可以删除。但是，如果您也喜欢的话，似乎您也可以一起使用其他一些构造，可能：

Sub Fixt()

Dim X As Long, Cell As Range
Dim arr1 As Variant: arr1 = Array("abc", ", ,", ", (", ", [", ", -")
Dim arr2 As Variant: arr2 = Array("", ",", " (", ", [", " -")

For Each Cell In Selection
    For X = Len(Cell.Text) - 2 To 1 Step -1
        Match = Application.Match(Cell.Characters(X, 3).Text, arr1, 0)
        If IsNumeric(Match) Then Cell.Characters(X, 3).Text = arr2(Match - 1)
    Next
Next

End Sub

Answer 5

试试，

Sub test()
    Dim rngDB As Range, rng As Range
    Dim i As Integer, x As Integer
    Dim vWhat As Variant, vReplace As Variant
    Dim s As String

    Set rngDB = Selection
    vWhat = Array("abc", ", ,", ", (", ", [", ", -")
    vReplace = Array("", ",", " (", " [", " -")

    For Each rng In rngDB
        x = Len(rng) - 2
        s = rng
        If x > 0 Then
            For i = 0 To UBound(vWhat)
                If Mid(s, x, 3) = vWhat(i) Then
                    rng.Characters(x, 3).Text = vReplace(i)
                End If
            Next i
        End If
    Next rng

End Sub