Excel用户定义的公式,以消除特殊字符

时间:2013-09-17 13:17:48

标签: excel-vba vba excel

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

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

这确实很好用,但有一种方法,我不需要每次需要时都寻找“新”特殊字符。例如,他的西部数据还包含一个“è”,它没有被交换,因此银行软件中的导入不起作用。

感谢您的帮助! 最大

4 个答案:

答案 0 :(得分:2)

您需要的是对THIS ASCII表

的方便引用

enter image description here

另外

  1. 您不需要这么多变数。
  2. 当您将变量声明为Dim umlaut1, umlaut2, umlaut3 As String时,只有最后一个变量在VBA中声明为字符串。前两个被声明为Variants
  3. 现在回到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,那么您可以获得解决方案,那么只需相应地修改代码:)

答案 1 :(得分: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

答案 2 :(得分:0)

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

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

答案 3 :(得分: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