更快地删除'；额外'；使用VBA for Excel的大范围单元格中的空格（多于1个）

如何更快地从包含文本字符串的大范围单元格中删除额外空格

比如说5000个以上的电池

我尝试过的一些方法包括：

For Each c In range
    c.Value = Trim(c.Value)
Next c

及

及

---

有什么提高速度的办法吗？

环路快把你累死了。这将一次性删除整个列中的空格：

Sub SpaceKiller()
   Worksheets("Sheet1").Columns("A").Replace _
      What:=" ", _
      Replacement:="", _
      SearchOrder:=xlByColumns, _
      MatchCase:=True
End Sub

调整范围以适应。如果要删除双空格，请执行以下操作：

Sub SpaceKiller()
   Worksheets("Sheet1").Columns("A").Replace _
      What:="  ", _
      Replacement:=" ", _
      SearchOrder:=xlByColumns, _
      MatchCase:=True
End Sub

编辑#1:

此版本将用单打替换双打，然后检查是否还有双打剩余

Sub SpaceKiller3()
   Worksheets("Sheet1").Columns("A").Replace _
      What:="  ", _
      Replacement:=" ", _
      SearchOrder:=xlByColumns, _
      MatchCase:=True

   Set r = Worksheets("Sheet1").Columns("A").Find(What:="  ")
   If r Is Nothing Then
      MsgBox "done"
   Else
      MsgBox "please run again"
   End If
End Sub

您可以重新运行，直到看到完成

编辑#2:

根据Don Donoghue的评论，此版本将递归运行，直到所有double转换为Single：

Sub SpaceKiller3()
   Worksheets("Sheet1").Columns("A").Replace _
      What:="  ", _
      Replacement:=" ", _
      SearchOrder:=xlByColumns, _
      MatchCase:=True

   Set r = Worksheets("Sheet1").Columns("A").Find(What:="  ")
   If r Is Nothing Then
      MsgBox "done"
   Else
      Call SpaceKiller3
   End If
End Sub

---

旁边有备用的柱子吗

Range("B1:B" & Range("A" & Rows.Count).End(xlUp).Row).Formula = "=Trim(A1)"
Columns(2).copy
Range("B1").PasteSpecial xlPasteValues
Columns(1).delete

我通常在大范围内使用Evaluate than循环。这个函数有很多用途，但我在这里不作进一步讨论

'change the row count as deemed necessary..
Set rng = Range("C1:C" & Row.Count)

   rng.value = Evaluate("IF(" & rng.Address & "<>"""", _
               TRIM(" & rng.Address & "),"""")")

Set rng = Nothing

“根据需要更改行数。。
设置rng=范围（“C1:C”和行数）
rng.value=Evaluate（“如果（“&rng.Address&”）_
修剪（&rng.Address&（“”）（“”））
设置rng=无

它可以依赖于很多东西，但在我的情况下，最快的是一次获取数组中的所有值：

' Dim range As Range, r As Long, c As Long, a
a = range
For r = 1 To UBound(a)
    For c = 1 To UBound(a, 2)
        a(r, c) = Trim(a(r, c))
    Next
Next
range = a

---

晚会迟到了，但是

不需要通过单元格/值进行迭代，也不需要递归函数来搜索和替换范围中的多个空格

wil实际上会处理单词之间的多个空格（并会修剪前导/尾随空格），使单词之间的单个空格保持不变

最棒的是，您可以为函数提供一个完整的范围（或数组），以便在一次扫描中执行此操作

---

---

---

需要考虑的一点是，通过这种方式，您将用其值覆盖目标范围内的任何公式。但根据您的问题，您正在使用包含文本值的

范围

对象。只是不需要迭代=）

您必须使用VBA吗？您可以通过外部使用.Net、Python、Perl等在电子表格上操作来提高性能。为什么不直接在电子表格上使用trim函数呢？加里-这很好，不过我希望它能删除所有多余的空间，并将其带到一个单独的空间。2比1，3比1。喜欢excel中的修剪功能。非常好！我还可以用“稍等一下”来实现自动化吗？将MsgBox“请再次运行”更改为SpaceKiller3，它将一直运行到没有任何程序为止。@DanDonoghue你真是个天才！我忘了反复做这件事了！这是一个快速的解决方案，我可能会使用Do，直到r不是最终的解决方案，而不是自我引用，这只是个人的观点，但我不喜欢subs自称。伟大的代码顺便说一句，Gary的学生，我没有想到使用替换功能：）。另一方面，您不需要在此处“调用”，只要子名称就足够了：）。@dan_Donoghue当需要删除后面的所有空格以及中间的额外空格时，这实际上是有效的。也很有用。谢谢这应该是最快的，但是工作表.Evaluate比应用程序快一点。Evaluate

rng=rng.Worksheet.Evaluate（“index（trim）（&rng.Address&>））”）

您介意解释一下Evaluate是如何在多单元格范围内迭代或扩展的吗？我想这是“评估”内部工作的一部分。不管怎么说，你的答案是一个完全的救生装置（即插即用）。您可以将范围替换为活动选择，并将其转换为按钮。从VBA Trim（）函数中，我永远猜不到Application.Trim函数的工作方式会有所不同。谢谢：）：+）展示了一种几乎被忽视的方式@JvdV++是的，我同意@T.M，我很少看到有人使用它。：）

'change the row count as deemed necessary..
Set rng = Range("C1:C" & Row.Count)

   rng.value = Evaluate("IF(" & rng.Address & "<>"""", _
               TRIM(" & rng.Address & "),"""")")

Set rng = Nothing

' Dim range As Range, r As Long, c As Long, a
a = range
For r = 1 To UBound(a)
    For c = 1 To UBound(a, 2)
        a(r, c) = Trim(a(r, c))
    Next
Next
range = a

Sub Test()

Dim rng As Range
Set rng = Sheets("Sheet1").Range("A1:A3")
rng.Value = Application.Trim(rng)

End Sub