按需剔除指定部位的不可见字符（以及空格）《附件在5楼》

zldccmx

核心代码如下：（全部代码均在窗体中)

Option Explicit
      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-15 下午 05:41:43
Private Sub CommandButton2_Click() '随机生成用于测试的字符串
    Dim Rng, Brr, Cel
    With Sheet1
        Set Rng = .[a2:d25]: Brr = Array(7, 8, 9, 10, 13, 28, 29, 30, 31, 32)
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        For Each Cel In Rng
            Cel.Value = Application.Rept(Chr(Brr(Int(Rnd * 9))), Int(Rnd * 5)) & "A" & Application.Rept(Chr(Brr(Int(Rnd * 9))), Int(Rnd * 5)) & "B" & Application.Rept(Chr(Brr(Int(Rnd * 9))), Int(Rnd * 5)) & "C" & Application.Rept(Chr(Brr(Int(Rnd * 9))), Int(Rnd * 5)) & "D" & Application.Rept(Chr(Brr(Int(Rnd * 9))), Int(Rnd * 5))
        Next
        .[a1:D1].Merge
        .[a1] = "含不可见字符之字符串"
        .[e1:h1].Merge
        .[e1] = "对应的字符串长度"
        .[e2:h25] = "=LEN(RC[-4])"
    End With
    Application.ScreenUpdating = True
End Sub
      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-15 下午 05:41:43
Sub MYCHECK1_CLICK()
    If MYCHECK1 = True Then Me.Tag = 1
End Sub

      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-15 下午 05:41:43
Sub MYCHECK2_CLICK()
    If MYCHECK2 = True Then Me.Tag = 2
End Sub

      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-15 下午 05:41:43
Sub MYCHECK3_CLICK()
    If MYCHECK3 = True Then Me.Tag = 3
End Sub

      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-15 下午 05:41:43
Sub MYCHECK4_CLICK()
    If MYCHECK4 = True Then Me.Tag = 4
End Sub

      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-15 下午 05:41:43
Sub MYCHECK5_CLICK()
    If MYCHECK5 = True Then Me.Tag = 5
End Sub


[ 本帖最后由 zldccmx 于 2009-7-16 11:05 编辑 ]

zldccmx

      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-15 下午 05:41:43
Private Sub COMMANDBUTTON1_CLICK()
    If Not (CheckBox1 Or CheckBox2) Then Exit Sub
    Dim Ans, M, A, B, C, N
    Ans = IIf(Me.Tag = "", 1, Me.Tag)
    Application.ScreenUpdating = False
    Dim I As Long , J As Long , Arr, T As Single     ', Ans
    T = Timer
    If CheckBox1 Then '单纯空格
        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
    End If
    If CheckBox2 Then '剔除不可见字符
        Dim Brr, Dic As New Dictionary
        Brr = Array(7, 8, 9, 10, 13, 28, 29, 30, 31) '
        For M = 0 To UBound (Brr): Dic(Chr(Brr(M))) = "": Next
        If Ans = 1 Then   '剔除全部不可见字符
            Selection = Application.Clean(Selection)
        Else
            Select Case Ans
            Case 2   '剔除左边不可见字符
                Arr = Selection
                For I = 1 To UBound (Arr, 1)
                    For J = 1 To UBound (Arr, 2)
                        For M = 1 To Len(Arr(I, J))
                            If Not Dic.Exists(Mid(Arr(I, J), M, 1)) Then Exit For
                        Next
                        Arr(I, J) = Mid(Arr(I, J), M)
                    Next
                Next
                Selection = Arr
            Case 3    '剔除右边不可见字符

zldccmx

                Arr = Selection
                For I = 1 To UBound (Arr, 1)
                    For J = 1 To UBound (Arr, 2)
                        For M = Len(Arr(I, J)) To 1 Step -1
                            If Not Dic.Exists(Mid(Arr(I, J), M, 1)) Then Exit For
                        Next
                        Arr(I, J) = Left(Arr(I, J), M)
                    Next
                Next
                Selection = Arr
            Case 4    '同时剔除两端不可见字符。
                Arr = Selection
                For I = 1 To UBound (Arr, 1)
                    For J = 1 To UBound (Arr, 2)
                        For M = 1 To Len(Arr(I, J))
                            If Not Dic.Exists(Mid(Arr(I, J), M, 1)) Then Exit For
                        Next
                        Arr(I, J) = Mid(Arr(I, J), M)
                        For M = Len(Arr(I, J)) To 1 Step -1
                            If Not Dic.Exists(Mid(Arr(I, J), M, 1)) Then Exit For
                        Next
                        Arr(I, J) = Left(Arr(I, J), M)
                    Next
                Next
                Selection = Arr
            Case 5    '剔除中间不可见字符，保留两端不可见字符
                Arr = Selection
                For I = 1 To UBound (Arr, 1)
                    For J = 1 To UBound (Arr, 2)
                        For M = 1 To Len(Arr(I, J))
                            If Not Dic.Exists(Mid(Arr(I, J), M, 1)) Then Exit For
                        Next
                        A = Left(Arr(I, J), M - 1): C = Mid(Arr(I, J), M)
                        For N = Len(C) To 1 Step -1
                            If Not Dic.Exists(Mid(Arr(I, J), N, 1)) Then Exit For
                        Next
                        B = Mid(C, N + 1): C = Left(C, N - 1)
                        For Each M In Dic.Keys
                            C = Replace(C, M, "")
                        Next
                        Arr(I, J) = A & C & B
                    Next
                Next
                Selection = Arr
            End Select
        End If
    End If
    Application.ScreenUpdating = True
    MsgBox "替换完毕" & vbLf & "用时共计 " & Timer - T & " 秒!", 64 + vbOKOnly, "友情提示"
End Sub

zldccmx

      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-15 下午 05:41:44
Private Sub UserForm_QueryClose(Cancel As Integer , CloseMode As Integer )
    Cancel = True
End Sub




下面是工作簿代码：
Option Explicit

      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-15 下午 05:45:32
Private Sub Workbook_BeforeClose(Cancel As Boolean )
    Unload 剔除空格
End Sub

      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-7-15 下午 05:45:32
Private Sub Workbook_Open()
    剔除空格.Show 0
End Sub

zldccmx

剔除空格及不可见字符.rar (17.46 KB, 下载次数: 109)

2009-7-15 17:47 上传

点击文件名下载附件
阅读权限: 20

这是一个比较完整的附件，源码全公开。

crystalxp

下载不了，权限不够好像

对不起，只有特定用户可以下载本论坛的附件，请返回。

[ 本帖最后由 crystalxp 于 2010-2-22 18:50 编辑 ]

byhyxb

下载，学习学习......

yniu88

这个文件太好了。解决了我一个大问题。一堆无规律的单元格里面充斥着不可见字符和空格。拿这个控件一扫光。

liuhu2005129

太好了，学习一下。

zenbu

这是我非常需要的，但附件下载不了