我有一个用来替换名称的函数用于将数据导入支付系统,因为这不接受任何特殊字符。
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
这确实很好用,但有一种方法,我不需要每次需要时都寻找“新”特殊字符。例如,他的西部数据还包含一个“è”,它没有被交换,因此银行软件中的导入不起作用。
感谢您的帮助! 最大
答案 0 :(得分:2)
您需要的是对THIS ASCII表
的方便引用
另外
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,那么您可以获得解决方案,那么只需相应地修改代码:)
答案 1 :(得分:1)
siddharth的代码附加评论加上
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