Excel удаляет все после двойного пробела

Question

В Excel я пытаюсь использовать Find and Replace для некоторых данных, чтобы удалить все после двойного пробела. Примером этих данных является ...

The Apples are Green  They are supplied by John
The Bannanas are Yellow  They are supplied by Tom
The Strawberries are Red  They are supplied by Jason

Я хочу, чтобы данные выглядели так ...

The Apples are Green
The Bannanas are Yellow
The Strawberries are Red

В Openoffice я могу найти '. *' и заменить его ничем, и это работает, но в Excel это не так.

Я в конечном итоге хочу превратить это в макрос, но сейчас я просто пытаюсь заставить его работать с Find and Replace, кто-нибудь может помочь?

Answer 1

Это немного другой подход к Крису. Я удаляю все неразрывные пробелы перед поиском space space.

Ваша проблема в том, что ваши строки содержат пробелы без пробелов. Пробел - это код 32. Непрерывный пробел - это код 160. Вы не можете найти space space, потому что ваши строки не содержат space space.

Попробуйте следующее:

Sub DeleteAfterDoubleSpace()

  Dim Pos As Integer
  Dim Rng As Range

  With Sheets("xxxxx")

    ' Replace any non-break spaces
    .Cells.Replace What:=Chr(160), Replacement:=" ", LookAt:=xlPart

    ' Find the first cell containing double space, if any
    Set Rng = .Cells.Find("  ", .Range("A1"), xlValues, xlPart, xlByRows, xlNext)
    Do While True
      If Rng Is Nothing Then
        '  All double spaces removed, exit.
        Exit Do
      End If
      Pos = InStr(Rng.Value, "  ")    ' Find position of double space within cell
      ' Extract first Pos-1 characters from cell and set cell to those characters.
      Rng.Value = Mid(Rng.Characters, 1, Pos - 1)
      Set Rng = .Cells.FindNext(Rng)  ' Find the next double space  
    Loop

  End With

End Sub

приписка

Я обнаружил неразрывные пробелы, вставив ваши строки в ячейку A1 рабочего листа и вызвав следующую процедуру так:

Call DsplDiag(Range("A1")

Выход для первой строки:

  T  h  e     A  p  p  l  e  s     a  r  e     G  r  e  e  n        T  h  e
 54 68 65 20 41 70 70 6C 65 73 20 61 72 65 20 47 72 65 65 6E 20 A0 54 68 65

  y     a  r  e     s  u  p  p  l  i  e  d     b  y     J  o  h  n   
 79 20 61 72 65 20 73 75 70 70 6C 69 65 64 20 62 79 20 4A 6F 68 6E A0

Обратите внимание на два А0 после Грина и в конце. A0 является шестнадцатеричным для 160.

Sub DsplDiag(DsplStg As String)

  ' Output the string DsplStg to the immediate window in both display and
  ' hexadecimal formats

  Dim CharChar As String
  Dim CharInt As Integer
  Dim CharStg As String
  Dim CharWidth As Integer
  Dim HexStg As String
  Dim Pos As Integer
  Dim Printable As Boolean

  CharStg = ""
  HexStg = ""

  For Pos = 1 To Len(DsplStg)
    CharChar = Mid(DsplStg, Pos, 1)
    CharInt = AscW(CharChar)
    Printable = True
    If CharInt > 255 Then
      CharWidth = 4
      ' Assume Unicode character is Printable
    Else
      CharWidth = 2
      If CharInt >= 32 And CharInt <> 127 Then
      Else
        Printable = False
      End If
    End If
    HexStg = HexStg & " " & Right(String(CharWidth, "0") & _
                                           Hex(CharInt), CharWidth)
    If Printable Then
      CharStg = CharStg & Space(CharWidth) & CharChar
    Else
      CharStg = CharStg & Space(CharWidth + 1)
    End If
    If Pos Mod 25 = 0 Then
      Debug.Print CharStg
      Debug.Print HexStg
      Debug.Print
      CharStg = ""
      HexStg = ""
    End If
  Next

  Debug.Print CharStg
  Debug.Print HexStg

End Sub

Answer 2

Поиск ' *' (то есть <space><space>*)

Обратите внимание, что в предоставленном примере текста из двух пробелов последовательность второй 'пробел' на самом деле является
«без перерыва» (код 160 ASCII).
Чтобы ввести это в поле поиска, введите Alt-0160 (на цифровой клавиатуре)

Чтобы сделать это в коде, обработайте 'пробел без перерывов' как пробел, сделайте это

Sub DeleteAfterDoubleSpace()
    Dim ws As Worksheet

    Set ws = ActiveSheet

    ' Replace any non-break spaces
    ws.Cells.Replace What:=Chr(160), Replacement:=" ", LookAt:=xlPart
    ' Replace double space*
    ws.Cells.Replace What:="  *", Replacement:="", LookAt:=xlPart
End Sub

Answer 3

Вот альтернативный способ сделать то, что вы пытаетесь достичь. Я считаю, что это дает вам больше контроля, чем Find и Replace.

' Get the contents of the cell
Dim s As String
s = Range("A1").Value
' Now write back only what precedes the double space
Range("A1").Value = Left(s, InStr(s, "  ") - 1)

Вышеуказанное действует только на одну ячейку. Чтобы сделать то же самое для многих ячеек, вы можете сделать это:

Dim cell As Range
For Each cell In Range("A1:A3")
    cell.Value = Left(cell.Value, InStr(cell.Value, "  ") - 1)
Next cell

Как указывалось в других ответах, вы должны заменить любые проблемные неразрывные пробелы (Chr(160)) на обычные пробелы, прежде чем искать двойные пробелы:

Dim cell As Range
For Each cell In Range("A1:A3")
    cell.Value = Left(cell.Value, _
        InStr(Replace(cell.Value, Chr(160), " "), "  ") - 1)
Next cell

РЕДАКТИРОВАТЬ Обращаясь к комментарию @chris neilsen:

Если в некоторых ваших целевых клетках отсутствуют двойные пробелы, вам следует проверить это перед использованием функции Left, чтобы она не вызвала ошибку:

Dim cell As Range
Dim i As Long
For Each cell In Range("A1:A5")
    i = InStr(Replace(cell.Value, Chr(160), " "), "  ")
    If i > 0 Then
        cell.Value = Left(cell.Value, i - 1)
    End If
Next cell

Теперь, при очень малой вероятности того, что некоторые ячейки назначения содержат формулы, содержащие двойные пробелы (например, =A1 & "<space><space>" & A2), эти формулы будут заменены значениями. Чтобы избежать этого, измените условное на If i > 0 And Not cell.HasFormula Then.