3

我正在尝试用常规字符替换重音字符。

当我尝试运行宏时，它不会出现在列表中。

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 = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
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
4

7 回答 7

8

我没有在我的宏列表中看到运行宏的选项。宏名称未出现在要选择的列表中。我启用了宏，并且我使用了许多其他宏，所以我不明白为什么它没有显示。– BvilleBullet 4 分钟前

请参阅上面代码中的注释。

'-- 用法：StripAccent Sheet1.Range("A1:C20")

你必须这样称呼它

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 = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
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
于 2012-04-05T17:17:38.470 回答
6

对于那些需要从所有罗马字符中删除重音符号的人，包括越南语中使用的扩展字符，请按照以下说明进行操作。

  1. 首先，让我们准备电子表格以发挥 VBA 的魔力。在 Microsoft VBA 编辑器中，选择 Tools / References 并在“Microsoft Scripting Runtime”旁边打勾。在后续步骤中，我们将需要它来定义字典对象。

  2. 接下来，我们创建一个全局字典，以便将重音字符映射到它们的非重音等价物。这是在Workbook_Open触发事件时完成的，因此字典仅在您打开电子表格时启动一次，而不是每次调用函数时启动。AsciiDict在步骤 3 中定义为公共变量。在“Project - 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
  1. 最后，我们创建一个调用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
  1. 保存并重新打开电子表格，以便正确启动映射字典。

用法：

=StripDiacritics("Hermès Prêt à Porter") 输出“Hermes Pret a Porter” =StripDiacritics("Việt Nam Textiles") 输出“Viet Nam Textiles”

对于那些好奇的人，可以在这里找到完整的映射：https ://goo.gl/Vvn9px 。字典键对应于 Dec 列。

于 2016-01-14T07:25:59.353 回答
6 
Function stripAccent(Text As String) As String

    Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
    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
于 2017-11-06T00:07:32.970 回答
0

你的意思是宏对话框中的宏列表？如果是这样，那是因为范围参数，宏对话框将只列出没有参数的程序。

于 2012-04-05T17:16:40.833 回答
0

您可以将 userForm 与 refEdit 和按钮控件一起使用。调用表单的例程类似于：

Sub ShowForm()

    Dim d As dlg
    Set d = New dlg

    d.Show

    Set d = Nothing

End Sub

...并在按钮的单击事件中：

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

假设userForm名称为dlg，按钮cmdBtn和refEdit控件为refEditControl。

于 2012-04-05T17:30:35.400 回答
0

@notGeek 提供的功能stripAccent对我有用，只是它将小写重音字符转换为大写非重音字符。

这似乎是因为Replace默认情况下该函数不区分大小写。这可以通过添加如下比较设置来vbBinaryCompare改变

Text = Replace(Text, A, B, , , vbBinaryCompare)
于 2019-07-17T11:44:23.870 回答
0

使用此代码从字符串中删除特殊字符。

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
于 2019-11-05T06:49:12.743 回答