Question

我有一个Excel宏，似乎可以用最接近的英语等价物替换电子表格中的某些变音字符。

我需要在变音符号列表中添加更多内容才能搜索。

我不需要＆＃34;权威/完整＆＃34;列表（和替换字符），理想情况下只是欧洲主要用途（变音符号，重音符号等）中常用的字符。

我希望这里的程序员有一个变音符号列表（或更好的，VBA代码，就像我的，使用它们），它们通常在编程语言中使用，以提供比下面的代码更好的解决方案。

Sub Replace_Diacritics()
    With Cells
        .Replace What:="á", Replacement:="a", MatchCase:=False
        .Replace What:="é", Replacement:="e", MatchCase:=False
        .Replace What:="í", Replacement:="i", MatchCase:=False
        .Replace What:="ó", Replacement:="o", MatchCase:=False
        .Replace What:="ú", Replacement:="u", MatchCase:=False
    End With
End Sub

Answer 1

char代码192..609的范围包含221个可用ASCII表示的字符（即可以从变音字符转换）：

ÀÃÃÃÃ¢Ã¢ËËÏÏÏÏ¢Ô¢Ô¢ÔÔÕÔÕÔÕâ€ óôöøúúúúĂĄąćĈĉĊċċďďďĐēēēĕĖĘĘĚĝĞĞĞĞĠġģĤĥĥĥ更多信息šŢŤťŦŧŨŪŬŭŮŰűŲųŵŶŷŹðŽŽƀƉƑƗƗƚƠơƫƮƯưưƶǍǏǐǐǒ ǓǔǕǗǘǙǚǜǞǟǤǥǦǧǨǩǪǬǬɡɡɡ

您可以尝试以下最简单的功能，但它的缺点是所有不能用ASCII表示的Unicode字符都将替换为?：

Function Replace_Diacritics(strText)
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Mode = 3
        .Open
        .Charset = "ascii"
        .WriteText strText
        .Position = 0
        Replace_Diacritics = .ReadText
        .Close
    End With
End Function

另一个更复杂的函数只替换可用ASCII表示的字符，其余的字符不变：

Function Replace_Diacritics(strText)

    Static objDict As Object
    Dim i, strRange, strCured, strChar, arrRes

    If objDict Is Nothing Then
        Set objDict = CreateObject("Scripting.Dictionary")
        strRange = ""
        For i = 192 To 609
            strRange = strRange & ChrW(i)
        Next
        With CreateObject("ADODB.Stream")
            .Type = 2
            .Mode = 3
            .Open
            .Charset = "ascii"
            .WriteText strRange
            .Position = 0
            strCured = .ReadText
            .Close
        End With
        For i = 192 To 609
            strChar = Mid(strCured, i - 191, 1)
            If strChar <> "?" Then objDict(ChrW(i)) = strChar
        Next
    End If

    arrRes = Array()
    ReDim arrRes(Len(strText))
    For i = 1 To Len(strText)
        strChar = Mid(strText, i, 1)
        If objDict.Exists(strChar) Then
            arrRes(i) = objDict(strChar)
        Else
            arrRes(i) = strChar
        End If
    Next
    Replace_Diacritics = Join(arrRes, "")

End Function

Excel宏用替换重音等效字符的重音字符

1 个答案: