TRANSLATE: 自定義Excel字元替換函數

10-17

來自專欄 Excel VBA編程開發

設計背景

在使用Excel處理各類數據時

Oracle、PostgreSQL等資料庫擁有

解決Excel無函數對文本中指定的多個字元進行對位替換或剔除。

用法說明

作用：對source_string內出現的任何位於from_string中的字元，替換為相應的to_string中的字元。如果from_string的字元長度超過了to_string，則相應字元的替換效果等價於刪除。

語法：

TRANSLATE(source_string, from_string, [to_string], [ignore_case])

source_string 待替換的源字元串。

from_string 源替換字符集。若為空字元串，則函數返回source_string。如果from_string長於to_string，則超出部分將被從source_string中剔除。from_string中若有重複字元，以最先出現的為準。

to_string 目標替換字符集，若留空，默認為空字元串。若為空字元串，則from_string中對應字元將均做剔除。

ignore_case 忽略大小寫，若留空，默認為FALSE。

translate_type 要替換待替換源字元串的何種位置：0表示首尾，1表示首，-1表示尾，2表示每一處。若留空則默認為0。

esc_source_string 待替換的源字元串中是否使用轉義字元序列，若留空，默認為FALSE。

esc_from_string 源替換字符集中是否使用轉義字元序列，若留空，默認為TRUE。

esc_to_string 目標替換字符集中是否使用轉義字元序列，若留空，默認為TRUE。

轉義字元序列：

a 響鈴退格 f 換頁

換行
回車製表符

v 垂直製表符 \ 反斜杠單引號

" 雙引號 ? 問號 e ESC字元

nn 八進位ASCII碼指定的字元

xhh 十六進位ASCII碼指定的字元

uhhhh 十六進位UCS-2碼指定的字元

效果展示

實現代碼

關於如何讓自定義函數代碼生效，請參閱微軟官方的文章在 Excel 中創建自定義的函數。也可以通過載入宏使得自定義函數在全部工作簿可用，操作方法請查閱官方文檔。

因代碼使用了VBScript正則表達式引擎，需要在Microsoft Visual Basic窗口菜單「工具-引用」中，加入「Microsoft VBScript Regular Expressions 5.5」（如下圖）。

具體代碼如下：

Option ExplicitPrivate Regex As New VBScript_RegExp_55.RegExpPublic Function EscapeString(source_string As String) As String Dim R As String, oMchColl As Object, Pos1 As Long, Pos2 As Long, k As Long, Pos3 As Long Regex.MultiLine = False Regex.IgnoreCase = False Regex.Global = True Regex.Pattern = "\[abfnrtv""?e]|\x[0-9a-fA-F]{1,2}|\u[0-9a-fA-F]{1,4}|\[0-7]{1,3}" R = vbNullString Set oMchColl = Regex.Execute(source_string) Pos1 = 1 For k = 1 To oMchColl.Count Pos2 = InStr(Pos1, source_string, oMchColl.Item(k - 1)) R = R & Mid(source_string, Pos1, Pos2 - Pos1) Select Case Mid(oMchColl.Item(k - 1), 2, 1) Case "a" R = R & ChrW(&H7&) Case "b" R = R & ChrW(&H8&) Case "f" R = R & ChrW(&HC&) Case "n" R = R & ChrW(&HA&) Case "r" R = R & ChrW(&HD&) Case "t" R = R & ChrW(&H9&) Case "v" R = R & ChrW(&HB&) Case "" R = R & ChrW(&H5C&) Case "" R = R & ChrW(&H27&) Case """" R = R & ChrW(&H22&) Case "?" R = R & ChrW(&H3F&) Case "e" R = R & ChrW(&H1B&) Case "x", "u" R = R & ChrW(CLng("&H" & Mid(oMchColl.Item(k - 1), 3))) Case Else R = R & ChrW(CLng("&O" & Mid(oMchColl.Item(k - 1), 2))) End Select Pos1 = Pos2 + Len(oMchColl.Item(k - 1)) Next k Set oMchColl = Nothing R = R & Mid(source_string, Pos1) EscapeString = REnd FunctionPublic Function TRANSLATE( _ ByVal source_string As String, _ Optional ByVal from_string As String = " x0dx0a", _ Optional ByVal to_string As String = vbNullString, _ Optional ignore_case As Boolean = False, _ Optional translate_type As Long = 0, _ Optional esc_source_string As Boolean = False, _ Optional esc_from_string As Boolean = True, _ Optional esc_to_string As Boolean = True _) As String Dim R As String, oMchColl As Object, Pos1 As Long, Pos2 As Long, k As Long, Pos3 As Long, i As Long If esc_source_string Then source_string = EscapeString(source_string) End If If esc_from_string Then from_string = EscapeString(from_string) End If If esc_to_string Then to_string = EscapeString(to_string) End If If from_string = vbNullString Then TRANSLATE = source_string Exit Function End If Regex.MultiLine = False Regex.IgnoreCase = ignore_case If ignore_case Then from_string = LCase(from_string) End If Regex.Global = True Regex.Pattern = "([]^\-])" Regex.Pattern = "[" & Regex.Replace(from_string, "$1") & "]+" Select Case translate_type Case 1 Regex.Pattern = "^" & Regex.Pattern Case -1 Regex.Pattern = Regex.Pattern & "$" Case 0 Regex.Pattern = "^" & Regex.Pattern & "|" & Regex.Pattern & "$" Case Else 2 End Select R = vbNullString Set oMchColl = Regex.Execute(source_string) Pos1 = 1 For k = 1 To oMchColl.Count Select Case translate_type Case -1 Pos2 = Len(source_string) - Len(oMchColl.Item(k - 1)) + 1 Case 0 Pos2 = InStr(Pos1, source_string, oMchColl.Item(k - 1)) If Pos2 <> 1 Then Pos2 = Len(source_string) - Len(oMchColl.Item(k - 1)) + 1 End If Case 1 Pos2 = 1 Case Else Pos2 = InStr(Pos1, source_string, oMchColl.Item(k - 1)) End Select R = R & Mid(source_string, Pos1, Pos2 - Pos1) For i = 1 To Len(oMchColl.Item(k - 1)) If ignore_case Then Pos3 = InStr(from_string, LCase(Mid(oMchColl.Item(k - 1), i, 1))) Else Pos3 = InStr(from_string, Mid(oMchColl.Item(k - 1), i, 1)) End If R = R & Mid(to_string, Pos3, 1) Next i Pos1 = Pos2 + Len(oMchColl.Item(k - 1)) Next k Set oMchColl = Nothing R = R & Mid(source_string, Pos1) TRANSLATE = REnd Function