Excel嵌套替代函数macros？ （超过64巢）

您好我想在Excel中创build一个macros，以replace表单中的每个单词的字符，以同一单元格中新的其他表单中的一些不同的字符。 我已经使用了function强大的function，但它只允许我使用64级。 我有大约100个或更多的巢穴。 请指导….

例如：

= SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( SUBSTITUTE( G1, "a","T"), "b","p"), "c","u"), "d","d"), "e","J"), "f","v"), "g","r"), "h","j"), "i","f"), "j","i"), "k","e"), "l","b"), "m","w"), "n","B"), "o","'"), "p","g"), "q","s"), "r","o"), "s",";"), "t","N"), "u","["), "v","t"), "w","k"), "x","D"), "y","/"), "z","I"), "0","0"), "1","1"), "2","2"), "3","3"), "4","4"), "5","5"), "6","6"), "7","7"), "8","8'"), "9","9"), "10","10"), "A","n"), "B","G"), "C","S"), "D","X"), "E","U"), "F","Y"), "G","x"), "H","Q"), "I","h"), "J","M"), "K","y"), "L","+"), "M","z"), "N","A"), "O","""), "P","c"), "Q","E"), "R","q"), "S","P"), "T","m"), "U","{"), "V","V"), "W","K"), "X",":"), "Y","""), "Z","}"), "0","0"), "%","#"), "^","\"), "&","|"), "*","!"), "(","("), ")",")"), "=","&"), "+","O'"), "[","."), "]","]") 

Answer 1

您可以在模块中添加以下函数，然后在公式中使用它：

 Function ReplaceSpecial(ByVal theString As String, ByVal find As String, ByVal replacement As String) As String Dim i As Integer, pos As Integer For i = 1 To Len(theString) pos = InStr(find, Mid(theString, i, 1)) If pos > 0 Then Mid(theString, i, 1) = Mid(replacement, pos, 1) Next ReplaceSpecial = theString End Function 

用法：

你可以像一个公式一样使用它。 喜欢这个，

 =ReplaceSpecial(G1, "abcdefghijklmnopqrstuvwxyz012345678910ABCDEFGHIJKLMNOPQRSTUVWXYZ0%^&*()=+[]", "TpudJvrjfiebwB'gso;N[tkD/I01234567890nGSXUYxQhMy+zA“”cEqPm{VK:}0#\|!()&O.]") 

或者，你可以像macros一样使用它。 实施取决于您的查找和replace值的位置。 假设它们分别在列A和B中，则可以添加以下macros并使用它。

 Sub ReplaceSpecialMacro() Dim find As String, replacement As String, result As String find = Join(Application.Transpose(Range("A:A").Value), "") replacement = Join(Application.Transpose(Range("B:B").Value), "") result = ReplaceSpecial(ActiveCell, find, replacement) MsgBox result '-- this is just for demo. you may put it in a cell etc. End Sub 

编辑：

下面的macros将在全部/选定的单元上运行ReplaceSpecial ：

 Sub ReplaceSpecialMacro() Dim find As String, replacement As String, currentCell As Excel.Range find = "abcdefghijklmnopqrstuvwxyz012345678910ABCDEFGHIJKLMNOPQRSTUVWXYZ0%^&*()=+[]" replacement = "TpudJvrjfiebwB'gso;N[tkD/I01234567890nGSXUYxQhMy+zA“”cEqPm{VK:}0#\|!()&O.]" Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select '-- comment out this line if you want to run only on currently selected cells For Each currentCell In Selection currentCell = ReplaceSpecial(currentCell, find, replacement) Next MsgBox "Done!" End Sub 

HTH。

Answer 2

这是一个非常简单的例子，它有75个替代：

 Public Function scramble(SIN As String) As String Dim temp As String, L As Long, i As Long Dim CH As String s1 = "0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz" s2 = "FPmbaXO`qwJz^_v:EY7yVehU6TDjBN45k]oplxMS8HA;[\u0ZfCri2>I9?n@=ts1QG3gd<LRcWK" L = Len(SIN) scramble = "" temp = "" For i = 1 To L CH = Mid(SIN, i, 1) j = InStr(s1, CH) If j = 0 Then temp = temp & CH Else temp = temp & Mid(s2, j, 1) End If Next i scramble = temp End Function 

原始字符在variabless1 ，replace字符在variabless2 。 例如：

Answer 3

Python有一个很好的string方法叫做translate 。 我们可以在VBA中做类似的事情：

 Function MakeTrans(Optional sourceChars As String, Optional targetChars As String, Optional deleteChars As String) As Object Dim i As Long, n As Long Dim c As String Dim D As Object Set D = CreateObject("Scripting.Dictionary") n = Len(sourceChars) For i = 1 To n c = Mid(sourceChars, i, 1) If Not D.Exists(c) Then D.Add c, Mid(targetChars, i, 1) End If Next i n = Len(deleteChars) For i = 1 To n c = Mid(deleteChars, i, 1) If Not D.Exists(c) Then D.Add c, "" End If Next i Set MakeTrans = D End Function Function Translate(sourceString As String, Optional sourceChars As String, Optional targetChars As String, Optional deleteChars As String, Optional transTable As Variant) As String Dim i As Long, n As Long Dim c As String, s As String Dim D As Object If IsMissing(transTable) Then Set D = MakeTrans(sourceChars, targetChars, deleteChars) Else Set D = transTable End If n = Len(sourceString) For i = 1 To n c = Mid(sourceString, i, 1) If D.Exists(c) Then s = s & D(c) Else s = s & c End If Next i Translate = s End Function 

这个函数接受一个string和一个replacestring，创build一个字典，第一个string中的每个字符都作为一个键，第二个string中的对应字符作为值（如果有这样的字符 -否则空string是值）。 然后，函数循环遍历源string，如果它具有相同的string，则用它的字典replace每个字符，否则保持独立。 作为替代调用序列，您可以单独创build翻译字典并将其直接传递给翻译function。 此外，可以显式传递要删除的字符列表 – 这使得函数更精确地匹配Python方法的function。

例如，

 Sub test() Dim D As Object Debug.Print Translate("IBM", "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "ZABCDEFGHIJKLMNOPQRSTUVWXY") Debug.Print Translate("Elephant", deleteChars:="AEIOUaeiou") Set D = MakeTrans("ZABCDEFGHIJKLMNOPQRSTUVWXY", "ABCDEFGHIJKLMNOPQRSTUVWXYZ") Debug.Print Translate("HAL", , , , D) Debug.Print Translate("HAL", transTable:=D) Set D = MakeTrans("", "", deleteChars:="AEIOUaeiou") Debug.Print Translate("Elephant", transTable:=D) End Sub 

哪个打印

 HAL lphnt IBM IBM lphnt 

该function是区分大小写的，当然可以调整。 在一系列具有相同转换string的单元格的循环中使用它会效率低下，因为它会反复创build和销毁同一个字典，在这种情况下，您应该使用另一个调用序列。

Answer 4

这是使用数组可能更快的另一种方法？

假设Sheet1中的列Col A具有需要replace的字符，而列Col B具有replace字符。 您可以添加尽可能多的，你想要的。 为了演示目的，我将在Col A使用两个字母。

现在试试这个

 Sub Sample() Dim ws As Worksheet Dim s As String Dim MyaR As Variant, sAr As Variant Dim lRow As Long, i As Long, j As Long '~~> This is our string s = "Siddharth" ReDim sAr(1 To Len(s)) For i = 1 To Len(s) sAr(i) = Mid(s, i, 1) Next i Set ws = Sheet1 With ws lRow = .Range("A" & .Rows.Count).End(xlUp).Row MyaR = .Range("A1:B" & lRow).Value For i = 1 To Len(s) For j = 1 To lRow If sAr(i) = MyaR(j, 1) Then sAr(i) = MyaR(j, 2) Exit For End If Next j Next i End With '~~> Output new value which is aibbharth Debug.Print Join(sAr, "") End Sub