vba 如何调用未出现在列表中的宏，将重音字符转换为常规字符？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/10032322/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to call a macro, to Convert Accented Characters to Regular, that does not appear in the list?
提问by BvilleBullet
I am trying to replace accented characters with regular characters.
我正在尝试用常规字符替换重音字符。
When I try to run the macro it doesn't appear in the list.
当我尝试运行宏时，它没有出现在列表中。
Option Explicit
'-- Add more chars to these 2 string as you want
'-- You may have problem with unicode chars that has code > 255
'-- such as some Vietnamese characters that are outside of ASCII code (0-255)
Const AccChars = "?????àá?????èéê?ìí??D?òó???ùú?üYàáa????èéê?ìí??e?òó???ùú?üy?"
Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
Sub StripAccent(aRange As Range)
'-- Usage: StripAccent Sheet1.Range("A1:C20")
Dim A As String * 1
Dim B As String * 1
Dim i As Integer
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, i, 1)
aRange.Replace What:=A, _
Replacement:=B, _
LookAt:=xlPart, _
MatchCase:=True
Next
End Sub
回答by Siddharth Rout
I do not see the option to run the macro in my macros list. The macro name is not appearing in the list to select. I have macros enabled and I have a bunch of others I use so I do not understand why it's not showing. – BvilleBullet 4 mins ago
我在我的宏列表中没有看到运行宏的选项。宏名称未出现在要选择的列表中。我启用了宏，并且我使用了很多其他宏，所以我不明白为什么它没有显示。– BvilleBullet 4 分钟前
Please see the comment in the above code.
请参阅上面代码中的注释。
'-- Usage: StripAccent Sheet1.Range("A1:C20")
'-- 用法：StripAccent Sheet1.Range("A1:C20")
You have to call it like this
你必须这样称呼它
Option Explicit
'-- Add more chars to these 2 string as you want
'-- You may have problem with unicode chars that has code > 255
'-- such as some Vietnamese characters that are outside of ASCII code (0-255)
Const AccChars = "?????àá?????èéê?ìí??D?òó???ùú?üYàáa????èéê?ìí??e?òó???ùú?üy?"
Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
'~~> This is how you have to call it. Now You can see the macro "Sample" in the list
Sub Sample()
StripAccent Sheet1.Range("A1:C20")
End Sub
Sub StripAccent(aRange As Range)
'-- Usage: StripAccent Sheet1.Range("A1:C20")
Dim A As String * 1
Dim B As String * 1
Dim i As Integer
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, i, 1)
aRange.Replace What:=A, _
Replacement:=B, _
LookAt:=xlPart, _
MatchCase:=True
Next
End Sub
回答by thdoan
For those who need to remove accent marks from ALL Roman characters, including extended ones like those used in Vietnamese, then follow the instructions below.
对于那些需要从所有罗马字符（包括像越南语中使用的扩展字符）中删除重音符号的人，请按照以下说明进行操作。
First, let's prepare the spreadsheet to do its VBA magic. In the Microsoft VBA editor, select Tools / References and put a checkmark next to "Microsoft Scripting Runtime". We'll need this to define a dictionary object in the subsequent steps.
Next, we create a global dictionary in order to map the accented characters to their unaccented equivalents. This is done when the
Workbook_Openevent is triggered so that the dictionary is only initiated once when you open the spreadsheet instead of every time you call the function.AsciiDictis defined as a public variable in step 3. In the "Project - VBAProject" panel, double-click on ThisWorkbook to open the workbook scope. Paste the following code there (belowOption Explicit):
首先，让我们准备电子表格以发挥其 VBA 魔法。在 Microsoft VBA 编辑器中，选择工具/引用并在“Microsoft Scripting Runtime”旁边打勾。在后续步骤中，我们将需要它来定义字典对象。
接下来，我们创建一个全局字典，以便将重音字符映射到它们的非重音字符。这是在
Workbook_Open触发事件时完成的，因此字典仅在您打开电子表格时启动一次，而不是每次调用该函数时启动。AsciiDict在步骤 3 中定义为公共变量。在“项目 - VBAProject”面板中，双击 ThisWorkbook 以打开工作簿范围。将以下代码粘贴到那里（下面Option Explicit）：
Private Sub Workbook_Open()
InitDictionary
End Sub
Sub InitDictionary()
AsciiDict(192) = "A"
AsciiDict(193) = "A"
AsciiDict(194) = "A"
AsciiDict(195) = "A"
AsciiDict(196) = "A"
AsciiDict(197) = "A"
AsciiDict(199) = "C"
AsciiDict(200) = "E"
AsciiDict(201) = "E"
AsciiDict(202) = "E"
AsciiDict(203) = "E"
AsciiDict(204) = "I"
AsciiDict(205) = "I"
AsciiDict(206) = "I"
AsciiDict(207) = "I"
AsciiDict(208) = "D"
AsciiDict(209) = "N"
AsciiDict(210) = "O"
AsciiDict(211) = "O"
AsciiDict(212) = "O"
AsciiDict(213) = "O"
AsciiDict(214) = "O"
AsciiDict(217) = "U"
AsciiDict(218) = "U"
AsciiDict(219) = "U"
AsciiDict(220) = "U"
AsciiDict(221) = "Y"
AsciiDict(224) = "a"
AsciiDict(225) = "a"
AsciiDict(226) = "a"
AsciiDict(227) = "a"
AsciiDict(228) = "a"
AsciiDict(229) = "a"
AsciiDict(231) = "c"
AsciiDict(232) = "e"
AsciiDict(233) = "e"
AsciiDict(234) = "e"
AsciiDict(235) = "e"
AsciiDict(236) = "i"
AsciiDict(237) = "i"
AsciiDict(238) = "i"
AsciiDict(239) = "i"
AsciiDict(240) = "d"
AsciiDict(241) = "n"
AsciiDict(242) = "o"
AsciiDict(243) = "o"
AsciiDict(244) = "o"
AsciiDict(245) = "o"
AsciiDict(246) = "o"
AsciiDict(249) = "u"
AsciiDict(250) = "u"
AsciiDict(251) = "u"
AsciiDict(252) = "u"
AsciiDict(253) = "y"
AsciiDict(255) = "y"
AsciiDict(352) = "S"
AsciiDict(353) = "s"
AsciiDict(376) = "Y"
AsciiDict(381) = "Z"
AsciiDict(382) = "z"
AsciiDict(258) = "A"
AsciiDict(259) = "a"
AsciiDict(272) = "D"
AsciiDict(273) = "d"
AsciiDict(296) = "I"
AsciiDict(297) = "i"
AsciiDict(360) = "U"
AsciiDict(361) = "u"
AsciiDict(416) = "O"
AsciiDict(417) = "o"
AsciiDict(431) = "U"
AsciiDict(432) = "u"
AsciiDict(7840) = "A"
AsciiDict(7841) = "a"
AsciiDict(7842) = "A"
AsciiDict(7843) = "a"
AsciiDict(7844) = "A"
AsciiDict(7845) = "a"
AsciiDict(7846) = "A"
AsciiDict(7847) = "a"
AsciiDict(7848) = "A"
AsciiDict(7849) = "a"
AsciiDict(7850) = "A"
AsciiDict(7851) = "a"
AsciiDict(7852) = "A"
AsciiDict(7853) = "a"
AsciiDict(7854) = "A"
AsciiDict(7855) = "a"
AsciiDict(7856) = "A"
AsciiDict(7857) = "a"
AsciiDict(7858) = "A"
AsciiDict(7859) = "a"
AsciiDict(7860) = "A"
AsciiDict(7861) = "a"
AsciiDict(7862) = "A"
AsciiDict(7863) = "a"
AsciiDict(7864) = "E"
AsciiDict(7865) = "e"
AsciiDict(7866) = "E"
AsciiDict(7867) = "e"
AsciiDict(7868) = "E"
AsciiDict(7869) = "e"
AsciiDict(7870) = "E"
AsciiDict(7871) = "e"
AsciiDict(7872) = "E"
AsciiDict(7873) = "e"
AsciiDict(7874) = "E"
AsciiDict(7875) = "e"
AsciiDict(7876) = "E"
AsciiDict(7877) = "e"
AsciiDict(7878) = "E"
AsciiDict(7879) = "e"
AsciiDict(7880) = "I"
AsciiDict(7881) = "i"
AsciiDict(7882) = "I"
AsciiDict(7883) = "i"
AsciiDict(7884) = "O"
AsciiDict(7885) = "o"
AsciiDict(7886) = "O"
AsciiDict(7887) = "o"
AsciiDict(7888) = "O"
AsciiDict(7889) = "o"
AsciiDict(7890) = "O"
AsciiDict(7891) = "o"
AsciiDict(7892) = "O"
AsciiDict(7893) = "o"
AsciiDict(7894) = "O"
AsciiDict(7895) = "o"
AsciiDict(7896) = "O"
AsciiDict(7897) = "o"
AsciiDict(7898) = "O"
AsciiDict(7899) = "o"
AsciiDict(7900) = "O"
AsciiDict(7901) = "o"
AsciiDict(7902) = "O"
AsciiDict(7903) = "o"
AsciiDict(7904) = "O"
AsciiDict(7905) = "o"
AsciiDict(7906) = "O"
AsciiDict(7907) = "o"
AsciiDict(7908) = "U"
AsciiDict(7909) = "u"
AsciiDict(7910) = "U"
AsciiDict(7911) = "u"
AsciiDict(7912) = "U"
AsciiDict(7913) = "u"
AsciiDict(7914) = "U"
AsciiDict(7915) = "u"
AsciiDict(7916) = "U"
AsciiDict(7917) = "u"
AsciiDict(7918) = "U"
AsciiDict(7919) = "u"
AsciiDict(7920) = "U"
AsciiDict(7921) = "u"
AsciiDict(7922) = "Y"
AsciiDict(7923) = "y"
AsciiDict(7924) = "Y"
AsciiDict(7925) = "y"
AsciiDict(7926) = "Y"
AsciiDict(7927) = "y"
AsciiDict(7928) = "Y"
AsciiDict(7929) = "y"
AsciiDict(8363) = "d"
End Sub
- Finally, we create a function called
StripDiacritics()to normalize the text. In the "Project - VBAProject" panel, double-click on Modules / Module1 to open the module scope (if you don't see it, then you'll have to add it by right-clicking on ThisWorkbook and selecting Insert / Module). Paste the following code there (belowOption Explicit):
- 最后，我们创建了一个函数
StripDiacritics()来规范化文本。在“Project - VBAProject”面板中，双击 Modules / Module1 以打开模块范围（如果您没有看到它，则必须通过右键单击 ThisWorkbook 并选择 Insert / Module 来添加它） . 将以下代码粘贴到那里（下面Option Explicit）：
'Dictionary initiated in Workbook_Open()
Public AsciiDict As New Scripting.Dictionary
Function StripDiacritics(Text As String) As String
Text = Trim(Text)
If Text = "" Then Exit Function
Dim Char As String, _
NormalizedText As String, _
UnicodeCharCode As Long, _
i As Long
'Remove accent marks (diacritics) from text
For i = 1 To Len(Text)
Char = Mid(Text, i, 1)
UnicodeCharCode = AscW(Char)
If (UnicodeCharCode < 0) Then
'See http://support.microsoft.com/kb/272138
UnicodeCharCode = 65536 + UnicodeCharCode
End If
If AsciiDict.Exists(UnicodeCharCode) Then
NormalizedText = NormalizedText & AsciiDict.Item(UnicodeCharCode)
Else
NormalizedText = NormalizedText & Char
End If
Next
StripDiacritics = NormalizedText
End Function
- Save and re-open the spreadsheet for the mapping dictionary to be properly initiated.
- 保存并重新打开电子表格以正确启动映射字典。
Usage:
用法：
=StripDiacritics("Hermès Prêt à Porter")Outputs "Hermes Pret a Porter"
=StripDiacritics("Vi?t Nam Textiles")Outputs "Viet Nam Textiles"
=StripDiacritics("Hermès Prêt à Porter")输出“Hermes Pret a Porter”
=StripDiacritics("Vi?t Nam Textiles")输出“Viet Nam Textiles”
For those who are curious, the complete mappings can be found here: https://goo.gl/Vvn9px. The dictionary keys correspond to the Dec column.
对于那些好奇的人，可以在此处找到完整的映射：https: //goo.gl/Vvn9px。字典键对应于 Dec 列。
回答by notGeek
Function stripAccent(Text As String) As String
Const AccChars = "?????àá?????èéê?ìí??D?òó???ùú?üYàáa????èéê?ìí??e?òó???ùú?üy?"
Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
Dim A As String * 1
Dim B As String * 1
Dim i As Integer
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, i, 1)
Text = Replace(Text, A, B)
Next
stripAccent = Text
End Function
回答by xyzasdfasdf
You mean the list of macros in Macro Dialog Box ? If so, it's because the range parameters, the Macro Dialog Box will list only procedures without parameters.
你的意思是宏对话框中的宏列表？如果是这样，那是因为范围参数，宏对话框将只列出没有参数的程序。
回答by xyzasdfasdf
You can use a userForm with a refEdit and button control. The routine that call the form is something like:
您可以将用户窗体与 refEdit 和按钮控件一起使用。调用表单的例程类似于：
Sub ShowForm()
Dim d As dlg
Set d = New dlg
d.Show
Set d = Nothing
End Sub
...and in the click event of the button:
...并在按钮的点击事件中：
Private Sub cmdBtn_Click()
On Error GoTo cmdBtn_Click_Err
Dim strRange As String
Dim rng As Range
strRange = refeditControl.Text
Set rng = Range(strRange)
Call StripAccent(rng)
cmdBtn_Click_Exit:
Exit Sub
cmdBtn_Click_Err:
MsgBox Err.Description
Resume cmdBtn_Click_Exit
End Sub
Assuming the userForm is name dlg, the button cmdBtn and the refEdit control refEditControl.
假设userForm 名为dlg，按钮cmdBtn 和refEdit 控件refEditControl。
回答by Malcolm Weller
The function provided by @notGeek stripAccentworked for me except it converted lower case accented characters to uppercase non-accented characters.
@notGeek 提供的函数stripAccent对我有用，只是它将小写重音字符转换为大写非重音字符。
This seems to be because the Replacefunction by default is case insensitive. This can be changed by adding the compare setting of vbBinaryCompareas below
这似乎是因为该Replace函数默认不区分大小写。这可以通过添加的比较设置更改vbBinaryCompare如下
Text = Replace(Text, A, B, , , vbBinaryCompare)
回答by Yogesh Gaur
Use this code to remove special character from the string.
使用此代码从字符串中删除特殊字符。
Function Remove(Str As String) As String
Dim xChars As String
Dim I As Long
xChars = "/.',_#$%@!()^*&"
For I = 1 To Len(xChars)
Str = Replace$(Str, Mid$(xChars, I, 1), "")
Next
Remove = Str
End Function
