工作中碰到过这种情况:有些外部收集来的资料,由于表格制作者不知道如何在单元格中输入换行符,他的做法是设置单元格格式自动换行,为了达到排版换行目的,是输入了一些空格用来占位的,这种表格在列宽变化了后,很可能就会变的有点乱,替换为真正的换行符或者其他符号就很有必要了:
如果空格确定的话,直接查找替换就可以,但是空格是不确定的,同时也不确定存在几段这种空白。
所以程序必须考虑到多段不确定空白的情况:
- 使用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