3

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

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
4

2 回答 2

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”或“é”。您可以在此处或帮助文件中了解更多信息 。这是一个例子：

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áàã]")

这种方法的优点是您只需要一个“翻译”即可进行比较。如果您有大型数据集，这可以提高性能

于 2013-06-17T19:18:55.117 回答
0

您可以保留一个包含所有要替换的字符以及要替换它们的字符的数组。如果您“搜索”数据与使用该公式稍有不同，则会更容易。这就是我将如何做到的。

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中的字符列表将重音字符转换为常规字符

于 2013-06-17T19:28:52.400 回答