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

xyj

发布于 2020-07-28 14:16:28

1.1K0

发布于 2020-07-28 14:16:28

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

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

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

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

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

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

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

        <button id="rbbtnTrimSpace" label="替换空格" onAction="rbbtnTrimSpace"/>

回调函数：

Sub rbbtnTrimSpace(control As IRibbonControl)
    Call MRange.TrimSpace
End Sub

函数实现：

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

本文参与腾讯云自媒体分享计划，分享自微信公众号。

原始发表：2020-06-29，如有侵权请联系 cloudcommunity@tencent.com 删除

xml