VBA替换不确定数量的空白

1、需求：

有个表格，单元格内容里有不确定的空白，需要替换为1个特定的符号。

2、举例：

工作中碰到过这种情况：有些外部收集来的资料，由于表格制作者不知道如何在单元格中输入换行符，他的做法是设置单元格格式自动换行，为了达到排版换行目的，是输入了一些空格用来占位的：

3、代码实现

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

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

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

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

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

代码语言：javascript复制

Sub TrimSpace()
    Dim rng As Range
    Dim strReplace As String
    
    strReplace = VBA.vbNewLine
    
    Set rng = Range("D2:D4")
    
    Dim r As Range
    For Each r In rng
        r.Offset(0, 1).Value = FTrimSpace(VBA.CStr(r.Value), strReplace, 1)
    Next
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 人点赞