1

我有一个用于替换名称的函数，用于将数据导入支付系统，因为它不接受任何特殊字符。

Function UMLAUT(text As String)
'** Dimensionierung der Variablen
Dim umlaut1, umlaut2, umlaut3, umlaut4, _
umlaut5, umlaut6, umlaut7, umlaut8, umlaut9, _
umlaut10, umlaut11, umlaut12, umlaut13, umlaut14, _
umlaut15, umlaut16, umlaut17, umlaut18, umlaut19, _
umlaut20, umlaut21, umlaut22 As String

umlaut1 = Replace(text, "ü", "ue")
umlaut2 = Replace(umlaut1, "Ü", "Ue")
umlaut3 = Replace(umlaut2, "ä", "ae")
umlaut4 = Replace(umlaut3, "Ä", "Ae")
umlaut5 = Replace(umlaut4, "ö", "oe")
umlaut6 = Replace(umlaut5, "Ö", "Oe")
umlaut7 = Replace(umlaut6, "ß", "ss")
umlaut8 = Replace(umlaut7, "ó", "o")
umlaut9 = Replace(umlaut8, "&", "+")
umlaut10 = Replace(umlaut9, ";", ",")
umlaut11 = Replace(umlaut10, "é", "e")
umlaut12 = Replace(umlaut11, "á", "a")
umlaut13 = Replace(umlaut12, "à", "a")

UMLAUT = umlaut13

End Function

这确实可以正常工作，但是有没有一种方法，每次我需要这个时我都不必寻找“新”特殊字符。例如，he west 数据还包含一个è，它没有被交换，因此银行软件中的导入不起作用。

谢谢你的帮助！最大限度

4

4 回答 4

2

您需要的是对这个ASCII 表的方便参考

在此处输入图像描述

还

  1. 你不需要那么多变量。
  2. 当您将变量声明为Dim umlaut1, umlaut2, umlaut3 As String时，只有最后一个变量在 VBA 中被声明为字符串。前两个被声明为Variants

现在回到 ASCII 表。

如果您注意到特殊字符从 128 开始一直到 255，那么只需使用循环替换不需要的字符。

注意：您必须进行一次艰苦的工作。这也将确保您将来不必添加更多字符。在下面的代码中，只需按照上图所示的相同顺序添加要替换的文本。

代码：（未测试）

Function umlaut(text As String)
    Dim umlaut1 As String, rplString As String
    Dim i As Long, j as Long
    Dim MyArray

    '~~> One time slogging
    rplString = ",ue,e,,a,,,,,,,,......." '<~~ and so on.
    '~~> The first one before the comma is empty since we do
    '~~> not have any replacement for character represented by 128.
    '~~> The next one is for 129 and then 130 and so on so forth.
    '~~> The characters for which you do not have the replacement,
    '~~> leave them empty

    MyArray = Split(rplString, ",")

    umlaut1 = text: j = 0

    For i = 128 To 255
        umlaut1 = Replace(umlaut1, Chr(i), MyArray(j))
        j = j + 1
    Next

    umlaut = umlaut1
End Function

提示：如果您认为您可以通过只考虑 ASCII 166 来获得解决方案，那么只需相应地修改代码 :)

于 2013-09-17T13:52:02.790 回答
1

siddharth 的代码加上额外的注释加上

  • 德语的 rpl_string；
  • 对于消除的字符（无需替换），您可以放入任何您喜欢的符号

.

Function umlaut(text As String, Optional replaceEMPTYby As String = "")
    'great thx to Siddharth rout!
Dim umlaut1 As String, rplString As String
Dim i As Long, j As Long
Dim MyArray

    '~~> One time slogging
rplString = "EUR,,,f,,,,,,,S,,OE,,Z,,,,,,,,,,,(TM),s,,oe,,z,Y,,i,c,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,A,A,A,A,Ae,A,A,C,E,E,E,E,I,I,I,I,G,N,O,O,O,O,Oe,x,0,U,U,U,Ue,Y,b,ss,a,a,a,a,ae,a,ae,c,e,e,e,e,i,i,i,i,o,n,o,o,o,o,o,-,o,u,u,u,u,y,b,y" '<~~ and so on.
    '~~> The first one before the comma is empty since we do
    '~~> not have any replacement for character represented by 128.
    '~~> The next one is for 129 and then 130 and so on so forth.
    '~~> The characters for which you do not have the replacement,
    '~~> leave them empty
    'how to find out your own signs: in Excel in Cell A128 type formula =CHAR(ROW())
    'copy that down to 255. replace characters not wanted by the charcater wanted.
    'in B128 formula: =A128
    'in all cells from B129 down to 255 type/copy formula: =CONCATENATE(R[-1]C,"","",RC[-1])
    'paste the value from B255 in "rplstring" above!

If replaceEMPTYby <> "" Then
    rplString = Replace(rplString, ",,", "," & replaceEMPTYby & ",")
    rplString = Replace(rplString, ",,", "," & replaceEMPTYby & ",")
    rplString = Replace(rplString, ",,", "," & replaceEMPTYby & ",")
    If Mid(rplString, 1, 1) = "," Then rplString = replaceEMPTYby & rplString
    If Mid(rplString, Len(rplString), 1) = "," Then rplString = rplString & replaceEMPTYby
    Debug.Print rplString
End If

    MyArray = Split(rplString, ",")
    umlaut1 = text: j = 0

    For i = 128 To 255
        umlaut1 = Replace(umlaut1, Chr(i), MyArray(j))
        j = j + 1
    Next
    umlaut = umlaut1
End Function
于 2013-09-19T14:30:23.623 回答
0

没有简单的技巧，因为您使用的是自定义替换而不是删除字符。您可以消除额外的字符串变量：

Function UMLAUT(text As String) As String
    UMLAUT = Replace(text, "ü", "ue")
    UMLAUT = Replace(UMLAUT, "Ü", "Ue")
    UMLAUT = Replace(UMLAUT, "ä", "ae")
    UMLAUT = Replace(UMLAUT, "Ä", "Ae")
    UMLAUT = Replace(UMLAUT, "ö", "oe")
    UMLAUT = Replace(UMLAUT, "Ö", "Oe")
    UMLAUT = Replace(UMLAUT, "ß", "ss")
    UMLAUT = Replace(UMLAUT, "ó", "o")
    UMLAUT = Replace(UMLAUT, "&", "+")
    UMLAUT = Replace(UMLAUT, ";", ",")
    UMLAUT = Replace(UMLAUT, "é", "e")
    UMLAUT = Replace(UMLAUT, "á", "a")
    UMLAUT = Replace(UMLAUT, "à", "a")
End Function
于 2013-09-17T13:33:45.750 回答
0

像这样简单的事情怎么样？

Function replaceSpecialCharacters(givenString As String) As String

    Const SPECIAL_CHARS As String = "áéíóúýÁÉÍÓÚÝäëõöüÄËIÖÜ"
    Const REPLACE_CHARS As String = "aeiouyAEIOUYaeoouAEIOU"
    
    Dim i As Long
    
    For i = 1 To Len(SPECIAL_CHARS)
        givenString = replace(givenString, Mid(SPECIAL_CHARS, i, 1), Mid(REPLACE_CHARS, i, 1))
    Next i

    replaceSpecialCharacters = givenString

End Function
于 2020-07-16T08:49:21.637 回答