Question

您好我想在Excel中创建一个宏，将工作表中每个单词的字符替换为同一单元格中新其他工作表中的某些不同字符。我使用了替代功能，但它允许我仅使用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

Python有一个很好的字符串方法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

此函数接受一串字符和一串替换字符，创建一个字典，其中第一个字符串中的每个字符都用作键，第二个字符串中的相应字符作为值（如果有是任何这样的字符 - 否则空字符串是值）。然后函数循环遍历源字符串，用等效的字典替换每个字符，如果它有等价的话，否则不管它。作为替代调用序列，您可以单独创建翻译字典并将其直接传递给translate函数。此外，可以显式传递要删除的字符列表 - 这使得函数更准确地匹配Python方法的功能。

例如，

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

该功能区分大小写，当然可以进行调整。在具有相同翻译字符串的一系列单元格的循环中使用它将是低效的，因为它将重复创建和销毁相同的字典，在这种情况下，您应该使用另一个调用序列。

Answer 2

这是一个非常简单的例子，可以进行75次替换：

users.log

原始字符位于变量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中，替换字符位于变量s1中。例如：

Answer 3

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

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.]")

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

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

编辑：

以下宏将在所有/所选单元格上运行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 4

这是使用Arrays的另一种方式，可能更快？

我们在Col A中说Sheet1您的角色需要被替换，Col B有替换字符。您可以添加任意数量的内容。出于演示目的，我将在Col A中使用2个字母。

现在试试这个

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

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

4 个答案:

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

4 个答案:

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