Question

我不完全确定怎么说这个，但是，我有一个Excel宏，可以在我的工作簿中启用搜索功能。我的问题是我需要搜索才能将'é'理解为'e'。因此，如果我搜索“Belem”，我的结果将会以'Belém'回归。我该怎么做？感谢您的任何时间和考虑。

Sub city()
   If ActiveSheet.Name <> "City" Then Exit Sub
   LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
   Sheets("Results").Range("3:10000").Delete
   SearchTerm = Application.InputBox("What are you looking for?")
   Application.ScreenUpdating = False
   Range("W1") = SearchTerm
   Range("W2:W" & LastRow).FormulaR1C1 = _
   "=IF(ISERR(SEARCH(R1C23,RC[-22]&RC[-21]&RC[-20]&RC[-19]&RC[-18]&RC[-17]&RC[-16]&RC[-15]&RC[-15]&RC[-14]&RC[-13]&RC[-12]&RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1])),0,1)"
   If WorksheetFunction.CountIf(Columns(23), 1) = 0 Then
      Columns(23).Delete
      Application.ScreenUpdating = True
      MsgBox "None found."
   Else
      For Each Cell In Range("A2:A" & LastRow)
          If Cell.Offset(, 22) = 1 Then
             Cell.Resize(, 51).Copy Sheets("Results").Range("A" & Rows.Count).End(xlUp).Offset(1)
             x = x + 1
          End If
      Next Cell
      Columns(22).Delete
      Application.ScreenUpdating = True
      If x = 1 Then
         MsgBox "1 matching record was copied to Search Results tab."
      Else
         MsgBox x & " matching records were copied to Search Results tab."
      End If
   End If
End Sub

Answer 1

您可以修改搜索参数，然后使用like运算符，如下所示：

Sub city()

   Dim rngResult As Range
   Dim searchTerm As String, counter As Integer
   Dim values As Variant, value As Variant

   If ActiveSheet.Name <> "City" Then Exit Sub

   'First Cell with the results
   Set rngResult = <First cell of the result Range>
   'Uses a variant array to get all values from the range. This speeds up the routine
   values = <Area of Search>.Value
   'Converts to lowercase to do a case insensitive search (e.g. Belem = belem)
   searchTerm = LCase(Application.InputBox("What are you looking for?"))
   If searchTerm = "" Then Exit Sub

   ' "§" is just a placeholder
   searchTerm = Replace(searchTerm, "e", "§")
   searchTerm = Replace(searchTerm, "é", "§")
   searchTerm = Replace(searchTerm, "§", "[eé]")
   Application.ScreenUpdating = False

   counter = 0
   For Each value In values
       If LCase(value) Like searchTerm Then
           rngResult = value
           Set rngResult = rngResult.Offset(1, 0) 'Moves to the next line
           counter = counter + 1
       End If
   Next value

   If counter = 0 Then
       MsgBox "None found."
   Else
       MsgBox "Found " & counter & " results"
       'Do what you need to do with the results
   End If

   Application.ScreenUpdating = True

End Sub

所有结果都位于rngResult。

列

代码的作用是将“e”和“é”替换为“§”，然后将“§”替换为“[eé]”，（例如"bélem" -> "bél§m" -> "b§l§m" -> "b[eé]l[eé]m"）。

like将匹配该位置上的“e”或“é”。您可以在here或帮助文件中了解有关它的更多信息。这是一个例子：

bélem Like "b[eé]l[eé]m" ' true
belem like "b[eé]l[eé]m" ' true
recife like "b[eé]l[eé]m" ' false

您可以通过添加其他条件来搜索更多图表：

'Like will match "a","á", "à" and "ã"
searchTerm = Replace(searchTerm, "a", "§")
searchTerm = Replace(searchTerm, "á", "§")
searchTerm = Replace(searchTerm, "à", "§")
searchTerm = Replace(searchTerm, "ã", "§")
searchTerm = Replace(searchTerm, "§", "[aáàã]")

此方法的优点是您只需要一次“翻译”即可进行比较。如果您有大型数据集

，这可以提高性能

Answer 2

您可以保留要替换的所有字符的数组以及要替换它们的内容。如果你＆＃34;搜索＆＃34;它会更容易。您的数据与使用该公式的数据略有不同。这是我将如何做到的。

Sub FindCity()

    Dim shResults As Worksheet
    Dim vaData As Variant
    Dim i As Long, j As Long
    Dim sSearchTerm As String
    Dim sData As String
    Dim rNext As Range

    'Put all the data into an array
    vaData = ActiveSheet.UsedRange.Value

    'Get the search therm
    sSearchTerm = Application.InputBox("What are you looking for?")

    'Define and clear the results sheet
    Set shResults = ActiveWorkbook.Worksheets("Results")
    shResults.Range("A3").Resize(shResults.UsedRange.Rows.Count, 1).EntireRow.Delete

    'Loop through the data
    For i = LBound(vaData, 1) To UBound(vaData, 1)
        For j = LBound(vaData, 2) To UBound(vaData, 2)
            'Get rid of diacritial characters
            sData = LCase(Anglicize(vaData(i, j)))
            'Look for a match
            If InStr(1, sData, LCase(Anglicize(sSearchTerm))) > 0 Then
                'Write the row to the next available row on Results
                Set rNext = shResults.Cells(shResults.Rows.Count, 1).End(xlUp).Offset(1, 0)
                rNext.Resize(1, UBound(vaData, 2)).Value = Application.Index(vaData, i, 0)
                'Stop looking in that row after one match
                Exit For
            End If
        Next j
    Next i

End Sub

Public Function Anglicize(ByVal sInput As String) As String

    Dim vaGood As Variant
    Dim vaBad As Variant
    Dim i As Long
    Dim sReturn As String

    'Replace any 'bad' characters with 'good' characters

    vaGood = Split("S,Z,s,z,Y,A,A,A,A,A,A,C,E,E,E,E,I,I,I,I,D,N,O,O,O,O,O,U,U,U,U,Y,a,a,a,a,a,a,c,e,e,e,e,i,i,i,i,d,n,o,o,o,o,o,u,u,u,u,y,y", ",")
    vaBad = Split("Š,Ž,š,ž,Ÿ,À,Á,Â,Ã,Ä,Å,Ç,È,É,Ê,Ë,Ì,Í,Î,Ï,Ð,Ñ,Ò,Ó,Ô,Õ,Ö,Ù,Ú,Û,Ü,Ý,à,á,â,ã,ä,å,ç,è,é,ê,ë,ì,í,î,ï,ð,ñ,ò,ó,ô,õ,ö,ù,ú,û,ü,ý,ÿ", ",")
    sReturn = sInput

    For i = LBound(vaBad) To UBound(vaBad)
        sReturn = Replace$(sReturn, vaBad(i), vaGood(i))
    Next i

    Anglicize = sReturn

End Function

Excel 2007 VBA Converting Accented Characters to Regular

中的字符列表

如何阅读e＆amp; é与excel中的搜索宏一样

2 个答案: