VBA代码库07：功能强大的字符替换函数

学习Excel技术，关注微信公众号：

excelperfect

下面的自定义函数：TranslateString函数，可以一次将指定的多个字符替换成相对应的匹配字符。

TranslateString函数代码如下：

'---------------------------------------------------------

'将文本中指定的字符替换成对应的字符

'参数strInput:要修改的文本字符串

'参数strMapInput:查找并要被替换掉的字符

'参数strMapOutput:0个或多个字符,与strMapInput中字符对应,

'若其比strMapInput短,则以其最后一个字符在其末尾填充至与

'strMapInput长度相同

'参数CaseSensitive:可选,默认为True表示区分大小写

'---------------------------------------------------------

Function TranslateString(ByVal strInputAs String, _

ByVal strMapInput As String, _

ByVal strMapOutput As String, _

Optional CaseSensitive As Boolean = True) As String

Dim i As Integer

Dim iPos As Integer

Dim strChar As String * 1

Dim strOutput As String

Dim iMode As Integer

'是否有要修改的文本字符串

If Len(strMapInput) > 0 Then

'是否区分大小写

If CaseSensitive Then

iMode = vbBinaryCompare

Else

iMode = vbTextCompare

End If

'确保strMapOutput与strMapInput指定的字符串有相同数量的字符

'保证了strMapInput中的字符能够被替换成strMapOutput对应字符

If Len(strMapOutput) > 0 Then

strMapOutput = Left$(strMapOutput& _

String(Len(strMapInput),Right$(strMapOutput, 1)), _

Len(strMapInput))

End If

'遍历要修改的文本字符串

For i = 1 To Len(strInput)

'依次取其中的每个字符

strChar = Mid$(strInput, i, 1)

'在strMapInput中查找是否存在这个字符

iPos = InStr(1, strMapInput,strChar, iMode)

'如果找到

If iPos > 0 Then

'在strMapOutput查找对应的匹配字符并添加到末尾

'即便strMapOutput为空,Mid函数也能处理

strOutput = strOutput &Mid$(strMapOutput, iPos, 1)

Else

'没有找到,则添加原字符到末尾

strOutput = strOutput &strChar

End If

Next i

End If

TranslateString = strOutput

End Function

下面来测试TranslateString函数。

下面的代码：

TranslateString(strText, "()-", "")

可以将(0717)676-1111转换成07176761111。如下图1所示。

图1

下面的代码：

TranslateString(strText, ",:!", "")

可以将"我,的微信公众号:完美Excel!"转换成"我的微信公众号完美Excel"。如下图2所示。

图2

下面的代码：

TranslateString(strText,"ABCDEFGHIJKLMNOPQRSTUVWXYZ", "00111222333444555666777889")

可以将086-1000-EXCELFANS转换成086-1000-181142046。如下图3所示。

图3

下面是代码的图片版：