Удалить пробелы между символами в ячейке, но только если между двумя отдельными символами существует пробел

Question

Для обработки в 10 000 строк Excel необходимо удалить пробелы между символами в ячейке, но только если между двумя отдельными символами существует пробел.

P J A JACKSON AND SONS

должен стать

PJA JACKSON AND SONS

но

JOHNSON AND SMITH

должен остаться

JOHNSON AND SMITH

Answer 1

Это может быть сделано с помощью регулярных выражений и поиска и замены. На вкладке «Главная» в группе «Редактирование» нажмите «Заменить», чтобы открыть диалоговое окно «Найти и заменить». Если вы не видите флажок «Использовать подстановочные знаки», нажмите «Дополнительно», а затем установите флажок.

Найти: (<[^\s]>) (<[^\s]>) Заменить: \1\2

Это будет соответствовать всем пробелам между двумя отдельными символами, а затем удалить их. Надеюсь это поможет!

Answer 2

Выберите ячейки, которые вы хотите обработать, и запустите этот макрос:

Sub formatter()
  Dim txt As String, i As Long
  Dim r As Range, txt2 As String

  For Each r In Selection
    txt = r.Text
    If InStr(1, txt, " ") > 0 Then
      ary = Split(txt, " ")
      txt2 = ary(0)
      For i = 1 To UBound(ary)
        If Len(ary(i - 1)) = 1 And Len(ary(i)) = 1 Then
          txt2 = txt2 & ary(i)
        Else
          txt2 = txt2 & " " & ary(i)
        End If
      Next i
      If txt2 <> txt Then
        r.Value = txt2
      End If
    End If
  Next r
End Sub

Answer 3

Вот решение с использованием VBA.

Использовать:

Нажмите Alt + F11 - Скопируйте код в ThisWorkbook

Вы можете запустить код из: MS Excel - вкладка « View » - Macros (горячая клавиша: Alt + F8)
Или Вы можете назначить ему кнопку.

Макрос будет применяться ко всем используемым ячейкам по умолчанию. Если вам нужно это изменить, просто оставьте комментарий, и я обновлю ответ с запрошенными изменениями.

Sub remove_spaces()

Dim actives As String
Dim c As Range
Dim myStr As String
Dim myArray() As String
Dim wordsc As String
Dim wcount As Integer
Dim newStr As String

actives = ActiveSheet.Name


For Each c In Sheets(actives).UsedRange.Cells

    If c <> "" Then     
        wordsc = c
        wcount = WordCount(wordsc)

        ReDim myArray(wcount)

        myStr = c
        myArray = Split(myStr, " ")
        c = ""
        newStr = myArray(0)

        For i = 1 To wcount - 1
            MsgBox myArray(i)
            If Len(myArray(i - 1)) = 1 And Len(myArray(i)) = 1 Then

                newStr = newStr & myArray(i)

            Else

                newStr = newStr & " " & myArray(i)

            End If

        c = newStr

        Next i

    End If

Next c



End Sub

Function WordCount(fullText As String) As Long
Dim words() As String
Dim firstLetter As String
Dim i As Long

  words = Split(fullText)

  For i = LBound(words) To UBound(words)
    firstLetter = UCase$(Left$(words(i), 1))
    ' if it's alphabetic, +1 word
    If firstLetter Like "[A-Za-z]" Then
      WordCount = WordCount + 1
    End If
  Next i

End Function