Excel搜索带重音符号的名称

7d7tgy0s  于 2023-11-20  发布在  其他
关注(0)|答案(3)|浏览(124)

是否可以在Excel电子表格中搜索可能包含重音符号的正常字母名称?如果可以,如何搜索?目前,除非你知道准确的拼写和哪些名字有重音字母,否则找不到结果。搜索是通过一个过滤电子表格的用户表单文本框完成的。例如,如果我搜索“莱昂”,我会找到像“伦纳德”这样的名字或姓氏,但我找不到“莉欧妮"
这个搜索似乎不区分大小写,这意味着它可以搜索其他字符数,所以我希望它能科普尖锐和严重的口音等,但它似乎没有。
我不想把所有口音都去掉,但现在,我想不出别的办法...

  • 由于评论而编辑 *

所以我试了这个:

Dim myAltPlyr As String
    myAltPlyr = "MAÇON"
    Dim ChkAccent As Long
    For ChkAccent = 1 To Len(myAltPlyr)
        If Asc(Mid(myAltPlyr, ChkAccent, 1)) = 138 Or Asc(Mid(myAltPlyr, ChkAccent, 1)) >= 192 Or Mid(myAltPlyr, ChkAccent, 1) = ChrW(&H10C) Then
            Select Case Asc(Mid(myAltPlyr, ChkAccent, 1))
            Case 192 To 198                      ' 7 x accented A
                Mid(myAltPlyr, ChkAccent, 1) = "A"
            Case 199                             ' 1 x Ç (C with cedilla)
                Mid(myAltPlyr, ChkAccent, 1) = "C"
            Case 200 To 203                      ' 4 x accented E
                Mid(myAltPlyr, ChkAccent, 1) = "E"
            Case 204 To 207                      ' 4 x accented I
                Mid(myAltPlyr, ChkAccent, 1) = "I"
            Case 209                             ' 1 x accented N (Ñ)
                Mid(myAltPlyr, ChkAccent, 1) = "N"
            Case 210 To 214                      ' 5 x accented O
                Mid(myAltPlyr, ChkAccent, 1) = "O"
            Case 217 To 220                      ' 4 x accented U
                Mid(myAltPlyr, ChkAccent, 1) = "U"
            Case 138                             ' 1 x accented S (Š)
                Mid(myAltPlyr, ChkAccent, 1) = "S"
'            Case 268                             ' 10C
'                Mid(myAltPlyr, ChkAccent, 1) = "S"
            Case Else
                If Mid(myAltPlyr, ChkAccent, 1) = ChrW(&H10C) Then  '
                    Mid(myAltPlyr, ChkAccent, 1) = "C"
                End If
            End Select
        End If
    Next
    Debug.Print myAltPlyr

字符串
我正在寻找一种使用普通文本搜索并找到结果的方法,无论它们是否包含口音。。
我现在有13,700行29列的名字--相当大--将近40万个单元格。

unhi4e5o

unhi4e5o1#

没有“内置”功能可以按照您的意愿工作。
我的建议是做一个“影子”工作表(你可以设置为隐藏),其中包含的名字没有重音字符,变音符号等,但替换“常规”字符。你只需要创建和“翻译”这个工作表一次,所以它不要紧,如果这需要一些时间:
a)创建一个这样的子文件(基于https://www.excelhow.net/replace-accented-characters.html)。检查特殊字符列表是否完整。唯一的缺点:德语的升-s(“”)字符通常被“ss”替换-如果你有这个(或其他字符),添加一个额外的替换命令。

Sub ReplaceAccentedChar(r As Range)
    Const fromChar As String = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ" 
    Const toChar As String = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy" 

    Dim i As Long
    For i = 1 To Len(fromChar)
        r.Replace Mid(fromChar, i, 1), Mid(toChar , i, 1), LookAt:=xlPart, MatchCase:=True
    Next i
    r.Replace "ß", "ss", LookAt:=xlPart, MatchCase:=True
End Sub

字符串
B)创建一个包含名字的工作表的副本。给工作表起你喜欢的名字--我取了"Shadow"
c)在即时窗口中,执行命令

ReplaceAccentedChar ThisWorkbook.Sheets("Shadow").UsedRange


d)对于原始工作表,添加Change-事件例程,以便在原始数据发生变化时更新阴影工作表

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range, shadowCell As Range
    For Each cell In Target
        Set shadowCell = ThisWorkbook.Sheets("Shadow").Cells(cell.row, cell.Column)
        shadowCell = cell
        ReplaceAccentedChar shadowCell
    Next
End Sub


e)现在是棘手的部分:设置过滤器。下面的例程将只过滤A列,修改它(可能将列作为额外的参数传递)。它将过滤特定字符串的阴影表,循环所有过滤的单元格,并从原始表中读取“真实的”名称。它将从中创建一个字典,这个字典用于将过滤器设置为原始表。

Sub FilterData(filterStr As String)
    If filterStr = "" Then Exit Sub
    ' Set filter on shadow sheet
    With ThisWorkbook.Sheets("Shadow")
        Dim r As Range
        Set r = Intersect(.UsedRange, .Range("A:A"))
        r.AutoFilter Field:=1, Criteria1:=filterStr
        Debug.Print r.SpecialCells(xlCellTypeVisible).Address
    End With
    
    ' Create list of "real" names into dictionary
    Dim d As Object, cell As Range
    Set d = CreateObject("Scripting.Dictionary")
    For Each cell In r.SpecialCells(xlCellTypeVisible)
        If cell.row <> 1 Then
            Dim realName As String
            realName = ThisWorkbook.Sheets("Names").Cells(cell.row, cell.Column)
            d.Add realName, ""
        End If
    Next
    
    ' Filter original sheet using the dictionary
    With ThisWorkbook.Sheets("Names")
        Set r = Intersect(.UsedRange, .Range("A:A"))
        If d.Count = 0 Then
            ' Nothing found, hide all
            r.AutoFilter Field:=1, Criteria1:=filterStr, Operator:=xlFilterValues
        Else
            r.AutoFilter Field:=1, Criteria1:=d.keys, Operator:=xlFilterValues
        End If
    End With
End Sub

8gsdolmq

8gsdolmq2#

一种方法可能是这样的

Dim c As Long, mycell As Range
For Each mycell In Range("B:B")
    For c = 1 To Len(mycell.Value)
        If Asc(Mid(mycell.Value, c, 1)) >= 192 Then ' add mode ASC conditions here as needed
            '
            'character found, your code here
            '
            Exit For
        End If
    Next
Next

字符串

3lxsmp7m

3lxsmp7m3#

由于OP没有透露太多细节,我的重点在于转换部分作为可能解决方案的重要部分 (除了@FunThomas的漂亮的“阴影转换”方法之外,其他想法可能是在评论中执行任何转换并在那里搜索)
我的巧妙的替代方法使用**Match()**函数以及两个帮助函数getABC()Ch2ar()将字符串字母转换为数组,而不是用 all 重音变体阅读 all 字母(参见旧文章)。
这种方法不仅允许

  • 比较整个ltr数组 (由字符串中的字母组成),以在单独的**abc数组 (由基本字母*“a”“z”*组成) 中搜索字母位置,而且
  • 通过省略其第三个参数(或:匹配类型1)一次性匹配前面的**无重音基本字母 *:
mtch = Application.Match(ltr, abc)   ' returning the found base positions in abc

字符串

主要功能plain()

  • 时间行为:对datafield数组中的40,000个字符串值执行函数plain()大约需要12秒。*
Function plain(Optional byval txt As String = "léon") As String
'Purp: Return unaccented base letters A-Za-z
'Note: Match always results in 1-based array
    Dim abc, ltr, mtch
    abc = getABC()              ' assign letters a-z to array abc (including "ß")
    ltr = Ch2Ar(txt)            ' assign each letter of input text to array ltr
    mtch = Application.Match(ltr, abc, 1) ' no 3rd argument finds base letter or MatchType:=1!
    Dim i As Long
    For i = 0 To UBound(ltr)    ' loop through letters
        If IsNumeric(mtch(i + 1)) Then
            Dim pos As Long
            pos = mtch(i + 1)
            ltr(i) = IIf(ltr(i) = UCase(ltr(i)), UCase(abc(pos)), abc(pos))
        End If
    Next i
    plain = Join(ltr, "")
    'plain = VBA.replace(plain, "ß", "ss", 1)

End Function

转换函数

Function Ch2Ar(ByVal s As String)
'Purp: change a string to array elements
    Dim tmp() As String
    tmp = Split(StrConv(s, vbUnicode), vbNullChar)
    ReDim Preserve tmp(0 To UBound(tmp) - 1)
    Ch2Ar = tmp
End Function
Function getABC()
'Purp:  return array of lowercase letters a-z
'       (including german "ß" - so called 'sharp s' - after "s")
'Note:  below split-version only valid for Microsoft Excel
    Dim abc
    If Application.Name = "Microsoft Excel" Then
        abc = Split( _
        Join([Char(Column(A:S)+96)], " ") & " ß " & _
        Join([Char(Column(T:Z)+96)], " "))
    Else
        abc = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", _
        "n", "o", "p", "q", "r", "s", "ß", "t", "u", "v", "w", "x", "y", "z")
    End If
    ReDim Preserve abc(1 To 27)
    getABC = abc
End Function

的字符串

相关问题