Excel 2007 VBA将重音字符转换为常规字符

时间：2012-04-05 16:23:30

标签： excel-vba excel-2007 vba excel

有人可以帮我确定为什么这个VBA宏代码在Excel 2007中不起作用？我试图用常规字符替换重音字符。代码编译没有问题但是当我尝试运行宏时它不会出现在列表中。

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

7 个答案:

答案 0 :(得分：6)

  
    
      

我没有看到在宏列表中运行宏的选项。宏名称未出现在要选择的列表中。我启用了宏，我有一堆其他的我使用，所以我不明白为什么它没有显示。 - 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

答案 1 :(得分：5)

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

  1. 首先，让我们准备电子表格来实现其VBA魔力。在Microsoft VBA编辑器中，选择“工具/引用”，并在“Microsoft Scripting Runtime”旁边打上复选标记。我们需要在后续步骤中定义字典对象。

  2. 接下来，我们创建一个全局字典，以便将重音字符映射到它们的非重音等价物。这是在触发Workbook_Open事件时完成的，这样只有在打开电子表格时才会启动字典，而不是每次调用该函数时。 AsciiDict在步骤3中定义为公共变量。在“项目 - VBAProject”面板中，双击ThisWorkbook以打开工作簿范围。在此处粘贴以下代码（Option Explicit下方）：

    3. 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下方）：
      2. '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. 保存并重新打开电子表格，以便正确启动映射字典。

        2. <强>用法：

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

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

答案 2 :(得分：3)

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

答案 3 :(得分：0)

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

答案 4 :(得分：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。

答案 5 :(得分：0)

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

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

Text = Replace(Text, A, B, , , vbBinaryCompare)

答案 6 :(得分：0)

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

implementation 'com.google.firebase:firebase-auth:19.1.0'
相关问题
最新问题