作品分享：批量剔除空格

zldccmx

老朽斗胆

      '改写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-13 下午 09:51:46
Sub 批量剔除空格()    '批量剔除空格，可以是区域，也可以是单列或者多列
    Application.ScreenUpdating = False
    Dim I As Long , J As Long , Arr, T As Single , Ans
    Ans = Application.InputBox("请选择剔除全部、左边还是右边。" & Chr(10) & "1：剔除全部空格；" & Chr(10) & "2：剔除左边空格。" & Chr(10) & "3：剔除右边空格。", "剔除方式", 1, 100, 100, , , 1)
    T = Timer
    Select Case Ans
    Case 1    '剔除全部空格
        Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart
    Case 2  '剔除左边空格
        Arr = Selection
        For I = 1 To UBound (Arr, 1)
            For J = 1 To UBound (Arr, 2)
                Arr(I, J) = LTrim(Arr(I, J))
            Next
        Next
        Selection = Arr
    Case 3    '剔除右边
        Arr = Selection
        For I = 1 To UBound (Arr, 1)
            For J = 1 To UBound (Arr, 2)
                Arr(I, J) = RTrim(Arr(I, J))
            Next
        Next
        Selection = Arr
    End Select
    Application.ScreenUpdating = True
    MsgBox "替换完毕" & vbCrLf & "用时共计 " & Timer - T & " 秒!", 64 + vbOKOnly, "友情提示"    '速度还可以
End Sub

泓()

学习
，请问一下
“复制内容到剪贴板” 这种论坛回帖格式的代码怎么搞的
看到 zldccmx 、狼版 都应用这个，，好

zldccmx

原帖由 little-key 于 2009-7-13 21:40 发表
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart这个只是其中一种情况，当是非标准的空格时，这句代码就无法起到作用了。

呵呵，我是从你1楼的代码来看的，因为你1楼的代码好像并没有考虑一个因素

zldccmx

原帖由 泓() 于 2009-7-13 21:57 发表
学习
，请问一下
“复制内容到剪贴板” 这种论坛回帖格式的代码怎么搞的
看到 zldccmx 、狼版 都应用这个，，好

1. 
   
2. 在你插入代码之前，先输入一组对应的[　code] 　[　/code],然后将代码插入到]  [中间
   
3. 使用 [C　O　D　E]　[/C　O　D　E]　，实际使用时去除中间的空格
   

复制代码

[ 本帖最后由 zldccmx 于 2009-7-13 22:02 编辑 ]

泓()

谢谢，学习了
那你12 楼的 这种格式又是怎么搞的（看上去不是手工的吧），，，再学习

zldccmx

也可以使用插入代码的按钮，在发帖的工具栏中有，类似WORD的批注框的图标就是，你点一下就明白

little-key

原帖由 zldccmx 于 2009-7-13 21:54 发表
老朽斗胆

      '改写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-13 下午 09:51:46
Sub 批量剔除空格()    '批量剔除空格，可以是区域，也可以是单列或者多列
    Application.Scr ...

请试试这个附件。

little-key

原帖由 laoyebin 于 2009-7-13 21:52 发表
trim并不能去除全部的假空字符

是可以，但是量比较大，而且是多列的时候，就显示出效率来了。

zldccmx

老朽再次斗胆，增加了左右和中间选项，共5　种　。经测试楼上的附件，结果正确！

Sub 批量剔除空格()    '批量剔除空格，可以是区域，也可以是单列或者多列
    Application.ScreenUpdating = False
    Dim I As Long , J As Long , Arr, T As Single , Ans
    Ans = Application.InputBox("请选择剔除全部、左边还是右边、中间还是两边？" & vbLf & vbLf _
                             & "1：剔除全部空格。　　   " _
                             & "2：剔除左边空格。" & vbLf _
                             & "3：剔除右边空格。   " _
                             & "4：同时剔除两边空格。" & vbLf _
                             & "5：剔除中间空格，保留两端空格。", "剔除方式", 1, 100, 100, , , 1)
    T = Timer
    Select Case Ans
    Case 1    '剔除全部空格
        Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart
    Case 2   '剔除左边空格
        Arr = Selection
        For I = 1 To UBound (Arr, 1)
            For J = 1 To UBound (Arr, 2)
                Arr(I, J) = LTrim(Arr(I, J))
            Next
        Next
        Selection = Arr
    Case 3    '剔除右边空格
        Arr = Selection
        For I = 1 To UBound (Arr, 1)
            For J = 1 To UBound (Arr, 2)
                Arr(I, J) = RTrim(Arr(I, J))
            Next
        Next
        Selection = Arr
    Case 4    '同时剔除两边空格。
        Arr = Selection
        For I = 1 To UBound (Arr, 1)
            For J = 1 To UBound (Arr, 2)
                Arr(I, J) = Trim(Arr(I, J))
            Next
        Next
        Selection = Arr
    Case 5    '剔除中间空格，保留两端空格
        Arr = Selection
        For I = 1 To UBound (Arr, 1)
            For J = 1 To UBound (Arr, 2)
                Arr(I, J) = Replace(Arr(I, J), Trim(Arr(I, J)), Replace(Trim(Arr(I, J)), " ", ""))
            Next
        Next
        Selection = Arr
    End Select
    Application.ScreenUpdating = True
    MsgBox "替换完毕" & vbLf & "用时共计 " & Timer - T & " 秒!", 64 + vbOKOnly, "友情提示"
End Sub

laoyebin

试试这个文件看看