Excel在双空格后删除所有内容

在Excel中，我尝试对一些数据使用查找和替换来删除双空格后的所有内容。这个数据的一个例子是

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中则不行

---

我最终确实想将其应用到宏中，但现在我只是想让它与“查找和替换”一起使用，有人能帮忙吗？

搜索

“*”

（也就是说，

*

）

注意，在提供的示例文本中，在两个空格序列中，第二个“空格”实际上是一个
“无中断空间”（ascii代码160）。
要将其输入搜索框，请键入

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

---

这与Chris的方法略有不同。在搜索

空格

之前，我删除了所有非中断空格

' 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)

您的问题是字符串包含非中断空格。空格是代码32。非中断空间为代码160。无法找到

空格

，因为字符串不包含

空格

请尝试以下操作：

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

p.S.

通过将字符串粘贴到工作表的单元格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

注意绿色后面和末端的两个A0。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

子DsplDiag（DsplStg作为字符串）
'将字符串DsplStg输出到显示屏和
'十六进制格式
Dim CharChar作为字符串
Dim CharInt作为整数
暗字符作为字符串
将字符宽度设置为整数
作为字符串的Dim HexStg
作为整数的Dim Pos
可打印为布尔值
CharStg=“”
HexStg=“”
对于Pos=1至Len（DsplStg）
CharChar=Mid（DsplStg，位置1）
CharInt=AscW（CharChar）
可打印=真
如果CharInt>255，则
字符宽度=4
'假定Unicode字符是可打印的
其他的
字符宽度=2
如果CharInt>=32和CharInt 127，则
其他的
可打印=错误
如果结束
如果结束
HexStg=HexStg&“”&Right（字符串（字符宽度，“0”）&_
十六进制（字符宽度）
如果可以打印，那么
CharStg=CharStg&Space（CharWidth）&CharChar
其他的
CharStg=CharStg和Space（CharWidth+1）
如果结束
如果位置Mod 25=0，则
调试.打印字符
调试。打印HexStg
调试。打印
CharStg=“”
HexStg=“”
如果结束
下一个
调试.打印字符
调试。打印HexStg
端接头

这里有另一种方法来完成您想要完成的任务。我发现它比

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&&&A2

），这些公式将被值替换。为了避免这种情况，如果i>0而不是cell.HasFormula，请将条件更改为

，然后

我已经尝试过了，尽管它成功地找到了每个项，但它不会替换它。我需要在替换框中输入一些特定的内容吗？有一点很奇怪：任何包含包含双空格的公式的单元格（例如“”之前之后的“”）都会在使用“编辑”>“替换”手动执行替换时导致错误，但如果您在执行替换时录制了宏（这会产生与您的宏类似的代码）并重放这个完全相同的宏，然后忽略公式，不会出现错误。奇怪。@Jean François Odd indead。似乎

.Replace

会导致无效公式自动失败并继续。如果你做了一个替换，结果得到了一个有效的公式，那么它会做替换谢谢，在几次配置更改之后，它最终工作了。我的结束这有两个问题：1。任何不包含2个空格的调用值都会导致错误。2.任何公式都会被值替换。好的，这些问题很容易解决。但是，该解决方案解决了问题中指定的问题，并且只有在OP决定将该声明应用于内容与问题中指定内容不同的范围时，才会给出“问题”。