vba 如何利用trim将文本中间的多余空格去掉

上清宫主

香川群子 发表于 2014-1-23 11:50
这根本没啥……

只能怪你自己知识面不够……

群子高抬了。在这帖子中所有现身者，没有哪个或哪些代表得了这里的水平
我更是，连这里的小学生都算不上，当然知识面是特别特别不够的
英雄太少，提升这里的水平就靠群子了

香川群子

顺便研究一下，发现在VBA中使用工作表函数Trim时，速度并不算很快。

100个字符以内，和自定义函数比速度差不多。
但如果字符较长时，还是有速度的。

1. Sub SpeedCompare()
   
2.     Dim i&, j&, p&, s$
   
3.     p = 4
   
4.    
   
5.     s = " 1-2 3    4-5   6  7 8    "
   
6.     For i = 1 To 2
   
7.         s = s & s
   
8.     Next
   
9.     Debug.Print " ": Debug.Print "-Begin- Len: " & Len(s)
   
10.     For j = 0 To 4
    
11.         tms = Timer
    
12.         For i = 1 To 10 ^ p
    
13.             Run "Test" & j, s
    
14.         Next
    
15.         Debug.Print "Test" & j & ": " & Format(Timer - tms, "0.0000s")
    
16.     Next
    
17.     Debug.Print "--End--"
    
18. End Sub
    
19. Sub test0(s$)
    
20.     t = trm(s)
    
21. End Sub
    
22. Sub test1(s$)
    
23.     t = trm1(s)
    
24. End Sub
    
25. Sub test2(s$)
    
26.     t = trm2(s)
    
27. End Sub
    
28. Sub test3(s$)
    
29.     t = trm3(s)
    
30. End Sub
    
31. Sub test4(s$)
    
32.     t = trm4(s)
    
33. End Sub
    
34. 
    
35. Sub test()
    
36.     s$ = " 1-2 3    4-5   6  7 8    "
    
37.     MsgBox s & vbCr & trm(s) & vbCr & trm2(s)
    
38.    
    
39.     t = Trim(s)
    
40.     t = Replace(t, " ", "| |")
    
41.     t = Split(t)
    
42.     t = Filter(t, "||", False)
    
43.     t = Join(t)
    
44.     t = Replace(t, "|", "")
    
45.    
    
46. End Sub
    
47. 
    
48. Function trm$(s$)
    
49.     trm = Application.Trim(s)
    
50. End Function
    
51. Function trm1$(s$)
    
52.     trm1 = Replace(Join(Filter(Split(Replace(Trim(s), " ", "| |")), "||", False)), "|", "")
    
53. End Function
    
54. Function trm2$(s$)
    
55.     Dim i&, s1$, s2$
    
56.     s1 = " " & s & " "
    
57.     For i = 1 To Len(s1) - 1
    
58.         If Mid(s1, i, 1) <> " " Then s2 = s2 & Mid(s1, i, 1) Else If Mid(s1, i + 1, 1) <> " " Then s2 = s2 & " "
    
59.     Next
    
60.     trm2 = Mid(s2, 2)
    
61. End Function
    
62. Function trm3$(s$)
    
63.     Dim s1$, s2$, n&
    
64.     s1 = Trim(s)
    
65.     Do
    
66.         n = InStr(s1, " "): If n = 0 Then Exit Do Else s2 = s2 & Left(s1, n): s1 = Trim(Mid(s1, n))
    
67.     Loop
    
68.     trm3 = s2 & s1
    
69. End Function
    
70. Function trm4(str As String) As String
    
71.     Dim str1 As String, str2 As String, n As Integer
    
72.     str = Trim(Replace(str, "　", ""))
    
73.     Do
    
74.         n = InStr(str, " ")
    
75.         If n > 0 Then
    
76.             str1 = Left(str, n)
    
77.             str = Trim(Mid(str, n))
    
78.             str2 = str2 & str1
    
79.         End If
    
80.     Loop Until n = 0
    
81.     trm4 = str2 & str
    
82. End Function
    

复制代码

香川群子

现编了一个用VBA函数方法反复处理得到结果的自定义函数：

trm1 = Replace(Join(Filter(Split(Replace(Trim(s), " ", "| |")), "||", False)), "|", "")


分解以后是这个样子：
Sub test()
    s$ = " 1-2 3    4-5   6  7 8    "
   
    t = Trim(s)                   '第一步用VBA的Trim函数去掉首尾空格
    t = Replace(t, " ", "| |") '第2步把所有空格置换为两堵墙（中间仍保留空格）
                                      '效果是可把有效内容按墙体进行分隔。
                         '你可以看到以墙体分隔的房间中存有有效内容或空格
    t = Split(t)                  '接着以空格为分隔符用Split函数拆分
                         '效果相当于去掉所有空房间
    t = Filter(t, "||", False)  '然后用Filter函数方法过滤去除所有空房间
                         '实际上到这里相当于去掉了所有多余的空格
    t = Join(t)                   '然后把剩余有内容的部分用join函数拼接起来
    t = Replace(t, "|", "")   ’最后把辅助用墙体拆掉，就彻底完成了
   
End Sub

这个方法很有趣，呵呵。

香川群子

接着写了个循环逐个字符检查比对后拼接的自定义函数：

Function trm2$(s$)
    Dim i&, s1$, s2$
    s1 = " " & s & " "
    For i = 1 To Len(s1) - 1
        If Mid(s1, i, 1) <> " " Then s2 = s2 & Mid(s1, i, 1) Else If Mid(s1, i + 1, 1) <> " " Then s2 = s2 & " "
    Next
    trm2 = Mid(s2, 2)
End Function

并没有什么复杂的。

结构写清楚点就是这样子了：

Function trm2$(s$)
    Dim i&, s1$, s2$
    s1 = " " & s & " "  '预处理首尾各加一个空格以便统一格式。
    For i = 1 To Len(s1) - 1 '因为最后一个一定是空格，所以循环次数-1
        If Mid(s1, i, 1) <> " " Then '如果当前字符不是空格
           s2 = s2 & Mid(s1, i, 1)  '那么直接拼接上去
        Else '如果是空格则需看下一个字符
           If Mid(s1, i + 1, 1) <> " " Then s2 = s2 & " "
              '下一个字符不是空格时就加一个空格上去作为要保留的分隔符
        End If
    Next
    trm2 = Mid(s2, 2) '最后把第一个多余的空格去掉
End Function

香川群子

至于5楼、6楼【雪舞子】的代码，效率比较高，
但代码中有冗余部分可以精简：

Function trm3$(s$)
    Dim s1$, s2$, n&
    s1 = Trim(s)
    Do
        n = InStr(s1, " "): If n = 0 Then Exit Do Else s2 = s2 & Left(s1, n): s1 = Trim(Mid(s1, n))
    Loop
    trm3 = s2 & s1
End Function


结构写清楚一点就是：

Function trm3$(s$)
    Dim s1$, s2$, n&
    s1 = Trim(s) '去掉首尾空格
    Do
        n = InStr(s1, " "): If n = 0 Then Exit Do '找空格位置,到没有空格时停止
        s2 = s2 & Left(s1, n) '把包含这个空格的左边部分拼接上去
        s1 = Trim(Mid(s1, n)) '剩余右边部分用Trim去除多余空格，然后继续
    Loop
    trm3 = s2 & s1 '把最后一部分也拼接上去
End Function


6楼代码中
str1 = Left(str, n)
str = Trim(Mid(str, n))
str2 = str2 & str1

这三句的第1和第3句，可以合并成一句……合并后速度略有提高。

香川群子

上清宫主 发表于 2014-1-23 12:36
群子高抬了。在这帖子中所有现身者，没有哪个或哪些代表得了这里的水平
我更是，连这里的小学生都算 ...

你这不已经是大学4年级了么……


EH 也有【上清】出现，和你是一个人么？

上清宫主

用工作表函数最好
用replace也差不到哪里去：
s$ = "terh                                    565     hdrth     f      "
s=trim(s)
Do While InStr(s, "  ")
   s = Replace(s, "     ", " ")
   s = Replace(s, "   ", " ")
   s = Replace(s, "  ", " ")
Loop
MsgBox s

蜂蜜柚子

fffox 发表于 2014-1-23 09:50
直接调用工作表函数trim不是更方便吗？
VBA函数trim只会删除文本的前导和尾随空格，对文本中间的多余空格无 ...

非常感谢~
接下来，比如我想让选中的所有单元格区域，都trim。

Selection.Value = WorksheetFunction.Trim(Selection)
这个公式只能trim一个单元格的，如何选中区域都被trim呢？

谢谢

fffox

蜂蜜柚子 发表于 2014-1-28 14:11
非常感谢~
接下来，比如我想让选中的所有单元格区域，都trim。

循环一下好了。

1. Sub test()
   
2.     Dim rng As Range
   
3.     For Each rng In ActiveSheet.UsedRange
   
4.         If Not IsEmpty(rng) And Not IsNumeric(rng.Value) Then
   
5.            rng.Value = WorksheetFunction.Trim(rng)
   
6.         End If
   
7.     Next
   
8. End Sub

复制代码

amw9422585

用application.trim也不能清除中间空格。不过用replace可以清除中间空格，可是楼主明确表示不能用replace.