使用 VBA for Excel 从大量单元格中删除 'extra' 个空格(超过 1 个)的更快方法

Faster way to remove 'extra' spaces (more than 1) from a large range of cells using VBA for Excel

如何从大量包含文本字符串的单元格中更快地删除多余空格?

假设有 5000 多个细胞。

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

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

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

For Each c In range
    c.Value = Replace(c.Value, "     ", " ")
Next c

有什么提高速度的想法吗?

循环快要死了。这将一次性删除整个列中的空格:

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

调整范围以适应。如果要删除 double 个空格,则:

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 的评论,此版本将 运行 递归地 直到所有双精度转换为单精度:

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 而不是大范围的循环。这个函数的用法有很多,这里就不多说了。

'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

聚会迟到了但是...

不需要通过 cells/values 进行迭代,也不需要递归函数来搜索和替换范围内的多个空格。

Application.Trim 实际上会处理单词之间的多个空格(并且会 trim leading/trailing 空格),完整地保留单词之间的单个空格。

它的妙处在于,您可以为函数提供一个完整范围(或数组)以一次性完成此操作!


Sub Test()

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

End Sub


要考虑的一件事是,通过这种方式,您将用它的值覆盖目标范围内的任何公式。但是根据您的问题,您使用的是 Range 包含文本值的对象。只是不需要迭代 =)