Удалите последние 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, если он содержится в конце выбранные ячейки.

Но для меня очень важно сохранить все исходное форматирование в ячейках (размер текста, цвета, жирный / курсив / подчеркнутые буквы и т. д. c).

Имейте в виду, что я полный новичок и ничего не знаю о программировании. Я скопировал приведенный выше код из inte rnet и просто изменил значения.

Заранее спасибо за вашу помощь.

Answer 1

Попробуйте,

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

Answer 2

Поскольку все ваши строки имеют длину 3, вам просто нужно отрегулировать l oop:

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 3

Заменить символы (сохранить форматирование)

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 4

Если вы хотите удалить последние три символа ячейки, если они ab c, тогда:

Перед:

код:

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 5

Что-то вроде этого, вероятно, сработает:

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 удалит эти символы без изменения отдельного символа форматирование вокруг него.