常用功能加载宏——替换不确定数量的空白

2020-07-28 14:16:28 浏览数 (2)

工作中碰到过这种情况:有些外部收集来的资料,由于表格制作者不知道如何在单元格中输入换行符,他的做法是设置单元格格式自动换行,为了达到排版换行目的,是输入了一些空格用来占位的,这种表格在列宽变化了后,很可能就会变的有点乱,替换为真正的换行符或者其他符号就很有必要了:

如果空格确定的话,直接查找替换就可以,但是空格是不确定的,同时也不确定存在几段这种空白。

所以程序必须考虑到多段不确定空白的情况:

  • 使用InStr找到空格开始的位置
  • 使用Loop找到非空白处

这样就确定了一段非空白的起止位置。

  • 然后继续对后面部分进行同样的处理,这里用递归就非常的合适了。

首先在customUI.xml的menu id="rbmenuString"中增加代码:

代码语言:javascript复制
        <button id="rbbtnTrimSpace" label="替换空格" onAction="rbbtnTrimSpace"/>

回调函数:

代码语言:javascript复制
Sub rbbtnTrimSpace(control As IRibbonControl)
    Call MRange.TrimSpace
End Sub

函数实现:

代码语言:javascript复制
Sub TrimSpace()
    Dim rng As Range
    Dim r As Range
    Dim strReplace As String
    
    strReplace = Application.InputBox("请输入需要替换为什么符号", Default:="、", Type:=2)
    If strReplace = "False" Then Exit Sub
    '如果输出的是newline,替换为换行符
    If VBA.LCase$(strReplace) = "newline" Then strReplace = vbNewLine
    
    
     '确保选中的是单元格
    If TypeName(Selection) = "Range" Then
        Set rng = Selection
        
        '如果替换为空字符,那么直接替换
        If VBA.Len(strReplace) = 0 Then
            rng.Replace " ", ""
            Exit Sub
        End If
    
        For Each r In rng
            r.Value = FTrimSpace(VBA.CStr(r.Value), strReplace, 1)
        Next
    End If
    
End Sub

'str    源数据
'strReplace    需要替换的符号
'iStart 搜索空格的起始位置
Function FTrimSpace(str As String, strReplace As String, iStart As Long) As String
    '清除左、右的空白
    str = VBA.LTrim$(str)
    str = VBA.RTrim$(str)
    
    Dim i As Long
    Dim first As Long
    Dim last As Long
    Dim iLen As Long
    
    iLen = VBA.Len(str)
    first = VBA.InStr(iStart, str, " ")
    If first Then
        '有空格的情况下继续查找到不是空格为止
        last = first   1
        
        Do Until last > iLen
            If VBA.Mid$(str, last, 1) <> " " Then
                Exit Do
            End If
            last = last   1
        Loop
        
        last = last - 1
        If last > first Then
            str = VBA.Left$(str, first - 1) & strReplace & VBA.Mid$(str, last   1)
        End If
        
        If last   1 < iLen Then
            '可能有多段的空白,递归
            str = FTrimSpace(str, strReplace, last   1)
        End If
    End If
    
    FTrimSpace = str
End Function

0 人点赞